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INTRODUCTION 


This  document  is  the  Software  Report  describing  the 
programs  and  subroutines  used  for  analysis  of  wind  and  acceler- 
ation data  recorded  at  long-span  bridge  sites  using  a  Govern- 
ment-owned Instrumentation  system. 

The  software  package  consists  of  various  combinations 
of  programs,  routines  and  subroutines  which  allow  for  tape 
reading,  statistical  data  summaries,  calibration  and  output- 
ting  of  data  values.   It  also  allows  for  obtaining  acceleration 
time  series  plots  and  frequency  spectra,  and  plots  for  the  wind 
parameters  relative  to  model  frequency  spectra. 

This  report,  as  listed  in  Table  1,  comprises  twelve  of 
the  most  significant  programs  which  include  those  routines 
associated  with  individual  programs.   In  addition,  general 
subroutines  are  provided  separately  to  support  programs  as 
indicated  by  Table  2.   Each  program  and  subroutines  are  indi- 
vidually organized  containing,  for  the  most  part,  the  following 
data: 

Programming  Introduction 
Operational  Notes 
General  Program  Setup 
General  Program  Flow  Chart 
Program  Listings 
Variable  Name  List 
Input  Card  Format 
Sample  Outputs 

The  following  documents  are  suggested  to  be  consulted  for 
more  detailed  information  on  the  Instrumentation  System: 

1.  Installation  and  Operation  Manual  for  An  Instrumentation 
System  to  Monitor  and  Record  Wind  Velocities,  Directions, 
and  Effects  at  Suspension  Bridge  Site,  Falls  Church, 
Virginia,  Undated. 

2.  Final  Report  for  An  Instrumentation  System  to  Monitor  and 
Record  Wind  Velocity,  Directors,  and  Effects  at  Suspension 
Bridges ,  Falls  Church,  Virginia,  March  1971. 

3.  C.  L.  Gerhardt  and  D.  D.  Nelson,  Monitoring  and  Recording 
Wind  Velocities,  Directions,  and  Effects  at  Comp-Span 
Bridge  Sites,  Report  No.  FHWA-RD-76-10 ,  Washington,  D.C., 
August  1977. 


4.  C.  L.  Gerhardt,  D.  D.  Nelson,  and  D.  M.  Grene,  Selected 
Wind  and  Bridge  Motion  Data  Recorded  at  Long-Span  Bridge 
Sites,  Report  No.  FHWA-RD-76-180 ,  Washington,  D.C., 
August  1976. 

5 .  A  Software  System  To  Analyze  Wind  Sensor  and  Accelerometer 
Data  Acquired  At  Bridge  Sites,  Falls  Church,  Virginia, 
July  1974. 


Table  1.   Signalling  Computer  Programs, 
Routines  &  Subroutines. 


NAME 
ACCPLT 

ACCSPC 

STPSPC 
CALFIL 

COPY 

DBLINT 
MODE 3D 

PBMPLT 

RHARM 
TAP SUM 

WNDSPC 

WNDPRM 
INTRPN 

DETRND 
NEWPRT 

SITKA 

WINDOW 


PURPOSE 

Generates  side-by-side  calibration  plots  of 
data  from  all  accelerometers  for  selected 
data  records.   (15  recs/page) . 

Calculates  and  plots  power  spectral  density 
for  selected  accelerometer  data.  10  RB  +  2 
Tower. 

Stepping  Spectra  of  1  accel.  channel. 

Updates  and  maintains  instrumentation  system 
channel  calibration  file. 

Copies  selected  records  from  data  base  to 
work  tape. 


Plots  three-dimensional  views  of  "geometrical 
bridge  configuration"  at  sequential  instants 
of  time.   Based  on  accel.  data. 

Generates  table  of  record-by-record  accelero- 
meter maxima,  and  averages  wind  directions  and 
velocities.   (One  pt.  per  record  +  wind/accel. 
correlation  +  wind  polar) . 

Finds  the  fourier  coefficients  of  one  dimen- 
sional real  data. 

Generates  index  and  10-minute  statistical 
summaries  for  all  data  recorded  on  field  data 
tapes . 

Calculates  and  plots  power  spectral  density  for 
selected  anemometer  data  for  up  to  5  channel 
each  U,  R,  W  plus  their  averages. 


A  subroutine  to  generate  missing  data  points 
through  interpolation. 


A  subroutine  to  read  Newport  data  tapes,  and 
demultiplex  and  calibrate  sensor  data. 

A  subroutine  to  read  Sitka  data  tapes,  and 
demultiplex  and  calibrate  sensor  data. 

A  subroutine  to  apply  10%  cosine^  taper  to 
data  samples. 


Table  2.   Major  Data  Analysis  Programs 


NOMENCLATURE    ASSOCIATED  SUBROUTINES 


ACCPLT 

ACCSPC 

STPSPC 
CALF I L 
COPY 

DBLINT 

MODE  3D 
RBMPLT 
RHARM 
TAP SUM 

WNDSPC 

+WNDPRM 

INTRPN 

DETRND2 

NEWPRT 

SITKA 

WINDOW 


INTPWA,  SPCPWA 


(INTPW2,  SPCPW2) 


GENERAL 
SUBROUTINE  CALLED 

SITKA 

DETRND 
SITKA    WINDOW 
RHARM 


TAPE,  CLEAN,  DDTRND , 
TTRACE,  SPECT 


POLAR 

HARM  (IBM) 

TIME,  HDG,  EVINST,  EVTERM, 
INTSUM 


INTPWW,  SPCPWW,  WCAL, 
WANGL,  AVERG2 


INTPWA   DETRND2 
SPCPWA   WINDOW 
SITKA    RHARM 

SITKA 

SITKA 


SITKA 


DETRND 2 

WINDOW 

RHARM 


PROGRAM  ACCPLT 


INTRODUCTION 

Program  ACCPLT  provides  a  continuous  printer  plot  of  13 
channels  of  acceleration  and  two  of  wind  direction  and  velocity 
from  magnetic  tapes  recorded  at  the  Sitka  Harbor,  Alaska  bridge. 
Also,  it  optionally  plots  all  13  accelerometers  on  a  Calcomp/ 
Tektronix  plot  of  15  records  (68  seconds  of  data)  per  page. 

In  addition  to  outputting  plots  of  Al  through  A13,  the 
ten  bridge  deck  accelerometers  may  be  displayed  as  sum  and  dif- 
ference pairs  by  setting  NDIF  ^0 .   For  example,  instead  of  the 
top  two  traces  being  Al  and  A2,  the  top  trace  will  show  the 
algebraic  sum  of  Al  and  A2  and  the  second  trace  the  difference 
A1-A2.   This  provides  a  good  indication  of  whether  the  bridge 
deck  motion  is  vertical  or  torsional,  corresponding  to  opposite 
sides  of  the  bridge  being  in  or  out  of  phase. 

See  Figures  1  through  6,  Table  3  and  Listing  1. 

OPERATIONAL  NOTES 

From  the  actual  calls  to  plot  in  inches,  all  data  is 
shrunk  by  the  factor  CCSIZE  for  the  desired  size  of  the  actual 
Calcomp  lot.   Since  the  Tektronix  graphics  further  shrinks  its 
plots  to  approximately  5  7%  of  the  Calcomp,  programs  such  as 
ACCPLT  which  use  it  contain  another  factor  of  1.74  to  compensate 
for  this. 

Multiple  request  cards  may  be  used  but  must  be  all  for 
the  same  tape  file. 


UNIT  10 


DISK 
CALFILE 


DISK 
SUBROUTINE 
LIBRARY 


LINE  PRIN- 
TER DATA  & 
PLOTS 


:alcomp 
tektronix 

PLOTS 


Figure    1.       Program   ACCPLT   Setup 
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Figure  2.   ACCPLT  Flow  Chart 
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Table  3.   ACCPLT  Variable  Name  List 


Name 

Com 

Type 

Dimension 

ACLM 

R 

1 

ALAST 

R 

13 

AMEAN 

R 

13 

AN 

I 

1 

AS 

I 

1 

BEGREC 

I 

1 

BLNK 

I 

1 

CARDIN 

I 

1 

CCSIZE 

R 

1 

DT 

R 

1 

ENDREC 

I 

1 

FPF 

I 

1 

I 

I 

1 

IBUF 

I 

4000 

I  DATE 

I 

1 

IFF 

I 

1 

II 

I 

1 

IPAGE 

I 

1 

IREC 

I 

1 

IREK 

I 

1 

IRF 

I 

1 

J 

I 

1 

KAC 

I 

1 

LSREC 

I 

1 

LTRI 

I 

1 

LTRN 

I 

1 

LTRS 

I 

1 

MCF 

I 

1 

NDIF 

I 

1 

NP 

I 

1 

NPAGES 

I 

1 

Usage 


Output  trace  number 

Stores  last  point  of  previous  rec. 

Mean  Values 

Literal  N 

Literal  S 

Starting  record  of  request 

Literal  blank 

Card  input  device 

Calcomp  plot  scaling  desired 

Sampling  interval 

Ending  record  of  request 

Need- to- print  lst-pt-of  rec.  flag 

General  index 

Plot  buffer  storage 

Date  of  input  tape  data 

SITKA  function  flag 

General  index 

Current  page  being  plotted 

Current  record  number 

Current  record  being  plotted 

Read  status  flag 

General  index 

Output  trace  index 

RECNO-1 
Literal  I 

Literal  N 

Literal  S 

Means-need-calibrating  flag 

Flag  for  sum-S-difference  option 

Number  of  points 

Number  of  pages  (integer) 
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Table  3.   ACCPLT  Variable  Name  List  (continued) 


Name 


Cora 


Type 


Dimension 


Usage 


NREC 

NSEC 

P 

PAGES 

PLEN 

PSIZE 

PRNTRI 

RADCON 

REC 

RECNO 

RELTIM 

SENS 

SKALE 

STAR 

T 

TAPENO 

TEKFAC 

TIMEHI 

TINC 

TINCM 

TINCS 

TRACE 

VSCAL 

WIDIR 

WIVEL 

W5DIR 

W5VEL 

X 

XLOC 

XI 

XX 


I 
I 
I 
R 
R 
R 
I 
R 
R 
R 
R 
R 

R 
I 
I 
I 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 


1 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
64,  37 
1 
1 
1 
2 
1 
1 
1 
1 
1 
7,  11 
1 
1 
1 
1 
1 
1 
1 
1 
1 


Number  of  records  to  plot 

Number  of  Sees/Page 

General  index 

No.  of  plot  pgs  in  current  request 

Length  of  data  axis  on  plot 

Final  plot  factor 

Printer  assignment 

Radians-to-degrees  conver.  factor 

Current  record  number 

Current  record  number 

Elapsed  time  since  start  of  request 

Array  containing  1  record  raw  data 

Scaling  factor  for  time  trace  plot 

Literal  asterik 

General  index 

Tape  number 

Tektronix/calcomp  adjustment  factor 

Height  of  tick  mark  traces 

Plotting  increment  between  data  pts 

Plotting  increment  per  minute 

Plot  spacing  for  1  sec  of  time 

Print  line  array 

Vertical  scale  of  time  trace 

Direction  of  wind  on  Wl 

Velocity  of  wind  1 

Direction  of  wind  on  W5 

Velocity  of  wind  5 

X  location  of  data  within  a  record 

X  coordinate  for  plotter  start 

X  location  of  minute  mark 

starting  X  location  for  data 
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Table    3.      ACCPLT  Variable  Name   List    (continued) 


Name 


Com 


Type 


Dimension 


Usage 


Y2 

YHI 

THI 


R 
R 
R 


Vert  offset  of  plot  data  from  zero 
baseline 

Offset  for  other  side  of  bridge 
Height  of  a  data  trace 
Height  of  VSCAL  from  baseline 
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LEVEL   21  MAIN  DATE  '    77146       __  19/42/33 

£  ***************  PROGRAM  ACCPLT     *************** 

C 

C PLOTS  BRIDGE  ACCELERATIONS  ANO  2  RESULTANT  WINDS   

C — FOR  EACH  RECOKD  BETtfEEN  SPECIFIED  BEGINNING  AND  ENDING  RECORDS 

C AS  ONE  CONTINUOUS  PRINTER  PLOT. 

C ALSO  PLOTS  ALL  13  ACCELEROMETERS  ON  CALCOMP/T EXTRONI X  PLOT 

C OF  15  RECORDS  PER  PAGE. 

C 

C ROUTINES    CALLcC:_SITKA 

C 

C      PROG.  BY  CHUCK  GEPHARDT    S.T.A.    1976 

C      MODIFIED  BY  DjANE  NELSON  DURING  1976  -  1977. 

C 

DIMENSION     IBUF (4000) ,ALAST(13) 
REAL    RADC0N,StNSU4,3  7|,RELTIM,AMEAN(13),WlDIR,W5DIR,WlVEL1J<5VEL 

INTEGER    CARDIE  ,PRNTR1, IFF, RECNO , IR F , BEGREC, ENDREC, MCF ,FPF, J , I,  " 
-II  ,T,P,BLNK,Tr<ACE(7,ll  ) ,L TRl ,LTRN  ,LTRS ,STAR,LSREC, AS, AN 

INTEGER    TAPENJI2) 
C 

C INITIALIZE    PRJGRAM    AND    DEVICES 

C  ALPHANUMERIw     CHARACTERS    STORED    LEFT    JUSTIFIED  

C 

DATA    BLNK/'     •/  ,LTP S/« S • /, LTRN/ • N» /  ,LTR I  /• I • /, S TAR/ •* • / 

CAPDIN=5 

PRNTRl=7 

RADCON=18  0.0/3.14159 
_DT=.07 

CCSlZe=.40 

TEKFAC=1.74 

PSIZE=CCSIZE*TEKFAC 

CALL  PLOTS  (ItiUFf4000,6) 

CALL  NEWPEN  (1  ) 

CALL  FACTOR  (P  SIZE) 

CALL  PLOT  CO.,0.,-3) 
C 

C        READ  TAPE  NJM8ER  CARD  AND  INITIALIZE  SENSOR  TABLE 
C 

IFF  =  l 

CALL  SITKAt  IFF  ,  RECNO , I RF , SENS , T APE  NO , I  DATE) 

PRINT  9001 
9001   FORMAT ( 1H1 , 'PRCCESSING  LOG'/) 
C 

C READ  DATA  REQJEST  CARD  AND  INITIALIZE  COUNTERS  FOR  ITS  REQUEST 

C 

100C   RE  AD(CARDIN',9i  CO,END=8000)  BEGREC, ENCREC , ND IF 

910j   F0RMATU5,  Til,  I5,T2l,I5) 

RECNO=BEGRFC 

NR  EC  =E  NDR  EC- B*.  GP  EC +  1 

PAGES=NREC/15. 

NPAGFS=PAGES+. 99 

NP=NREC*64 

IREC=0 

RELTIM=0.0 

MCF*l 
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LEVEL      2  i  _     ...MAIN  .__   .  .    JD AT  E  _».  77146 19/42/33 

PRINT    85,BEGRtC,ENDREC,NP,NPAGES,TAPENO,IDATE,NDlF 
85    FORMAT    (•     PLOTTING    RECORDS  »,  1 5,  •    THRUSI5,'     (  •  ,  15,  •    POINTS    FOR    •, 

112,  •_  PLOT    PAGt  S)       FROM    TAPE    't2A4,'    DATED'  ,  16,  5X,  '  NDI  M« ,  IJ_I 

C  ~ 

C      SETUP  EACH  15  RECORD  PAGE  STARTING  WITH  TIMING  MARKS 

C        EVERY  RECORJ  (4.54  SEC)  AT  TOP,  EVERY  1.0  SECONDS  AT  BOTTOM 

C 

DO  600  IPAGE=i  ,NPAGES 
_T]NC.  =  .020 

TINCM=f INC*64 

TIMEHI=13.3 

CALL    PLOT     (2.,  TIMEHI, *3  ) 

REC=BEGREC    *L>  ♦(  I  PAGE-1 ) 

CALL    NUMBER     (<.  .  2,  T  I  MEH  I-.  1 ,  .  18  ,REC,  0.  ,-1 ) 

XT=2.0 


DO    130    1=1,15 

XT=XT+TINCM 
130    CALL    SYMBOL    (X T , T I MEHI  ,  . 14 , 13 , 0. ,-1  J 

CALL    PLOT     (2., C.,+3) 

TIMEHI=0.0 
NSEC  =  4. 54*15. 

TINCS=TINCM/4. 54 

XT=2.0 

DO    140    I=i,NStC 

XT=XT+TINCS 
140   CALL     SYMBOL     (X T ,T I MEHI , .07 , 13 , 0. ,- 1 ) 
PLEN  =  TINC*64.*15. 

THI=.  12  5/PSIZt 

XLOC  =  0.0 

c 

C  PLOT    HEADER^     AND    BASELINES    FOR     ALL     13    ACCEL 

C  ADD    VERTICAL     AXIS    SCALE    VALUES    (1    INCH=.05    G) 

C  FOR    A12/A13     ,     1    INCH=.10G  FOR     Ail,     1     INCH=.20G 

C  VSCAL=    SCALfc-PER-INCH    *    THI 

C 

VSCAL=.0l5 

DO    200    KAC  =  1,13 

ACLM=KAC 
_YHI=13.4-KAC 

IF     (KAC.E3.il)  VSCAL=.120 

IF     (KAC.EQ.12.CR.KAC.E0.13)  VSCAL=.030  i 

CALL    NUMBER     (i .3, YHI+T HI , . 14, VSCAL , 0. , 3) 

CALL     SYMBOL     {<L . 1 , YHI+THI , . 14 , 13 ,90 . ,-i ) 

CALL    SYMBOL     (  J  .<♦ ,  YHl  ,  .  21  ,  1HA,  0.  ,  1  ) 

CALL    NUMBFR     ( J . 7 , YHI , . 2 1 , ACL M, 0. ,-i ) 

CALL     SYMBOL     i  i.  .6  ,  YHI  ,  .  14,  1H0,  0.  ,  1  ) 

CALL    NUMBER     (1 . 3, YH I-THI , . 14, VSCAL , 0 . ,3) 

CALL    SYMBOL     (2 . 1 , YHI-THI , . 14 , 13 ,90. ,-1 ) 

CALL    PLOT     12.0,  YHI,  +  3) 

CALL    PLOT     (PLcN+2.,YHl ,+2) 

CALL    PLOT     (2.0, YHI, *3) 

200  CONTINUE 

CALL    PLOT     (2., YHI, +3) 

DO    550    IREK  =  1,  15 
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LEVEL   21  MAIN  DATE  =  77146  19/42/33 

C 

C READ    DATA    RECJPD 


00       IFF=3 

CALL    SITKA (IFF  ,RECN0,  I  RF  ,  SENS  ,  T  A  PENO  ,  I  DAT  E) 

IPEC=IREC+l 

IF  (  IRF.NE. 1 )    „C    TO    7000 

FPF=1 

IF     (MCF.EQ.O)  GC    TO    2030  ____ 

C 

C CALCULATF    MEA.*S    FOR    A1-A13 

C 

J  =  0 

DO    20201=1,13 
_J=J*2  

AMEAN     (  I) =0.0 

DO    201011  =  1,6-, 

AMEAN (I)  =  AME Aw U )+SENS( 1 1, J) 
2010      CONTINUE 

AMEAN(  I  )  =  AME  A*  (  I  I  /64.  0 
2020      CONTINUE 
C 

C PRINT    HEADER    F CR    PRINTER-PLOT    OF    DATA 

C  AND    SET    MEANS    CALIBRATION    FLAG    TC    ZERO 

C 

2026       IF     (MCF.EQ.O)  GO    TO    2030 


92  00 


IF  (MCF.EQ.O)    GO  TO  2030 

WRITE  ( PRNTR1, 9200) 

FORMAT!  1H1  ,2X,  'RECORD/ » , 7X , • Al I • ,9X, ' A12- A 13» , 8X, '  W1S8X, •A1-A21, 

-  9X,  •A3-AA' ,*  X, 'A5-A6 • , 9X , • A7- A8* ,9Xf • A9-A10* ,8X,  «W5»/ 

-  4X, 'TIME • ,9a  ,'0.0   .3',7X,'0.0   . 06 • , 2X ,  ' DIR  VEL  ', 

-  5(6X,«0.0   . 03' ) ,2X,  'DIR  VEL'/ 

-  3X,7(  •-•  ),2l  3X,  •! I 1  •  ),3X,7{  •-•)* 5(3X«'I I 1  •)  , 

__-   3X,7M-')) 

MCF=0 
C 

C FOR  EACH  SCAN: 

C 

2030   DO  2100  1  =  1, 6«t 

RELTIM  =  RELTM+DT 
C 

C CALCULATE  RESJLTANT  HORIZONTAL  WIND 

C 

IF  (SENSU ,1). EQ.O.)    SENSII ,1 )=. 000001 

IF  ( SENS! I ,3). EC. 0.)    SENSU, 3)=. 030001 

IP  (SENS(  I  ,25)  .EQ.O.I    S ENS (  I , 25 )  =  . COOOO 1 

IF     (SENSU  ,27)  .EQ.O.I         "SENS  ( 1 ,  27)  =  .  000001 

WIDIR=(RADCCN*  ATAN2(  SENSU  ,1)  ,SENS(  1,3)  ))  4-8  5.0 

WIVEL=SQRT(  SENSU  ,  1 )  *SENS  (  1 , 1 )  *SENS  (  I  ,  3)  *S  ENS(  I  ,  3)  ) 

W5DIR=(RADC0N*  ATAN2(SENS( I, 25), SENS (I, 27))) +8 5.0 

W5VEL=SQRT( SEN  S(I  ,25)*  SENSU , 25 )+S ENS U , 27 ) *SENS (I , 27 ) ) 

IWIDIR=IF IX(W1 DIR) 


TWlVEL  =  lFTX(fci.VEL) 
IW5DIR=IF IXIH^DIR) 
IW5VEL=IFIX(W3 VEL) 
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L E VE L  __2  1 MAIN DATE    *   7  71*6 19/42/33 

C  _    ....._. 

C       INITIALIZE  TRACES 

C  


DO  2050  T=l,7 

DO  2043  P-ltil 

TRACE(T,P)=BL>JK 
2040   CONTINUE 

TRACE(T,6)=LTKI 

_2050      CONTINUE 

C 

C SET-UP    TRACES    FOR    A1-A10    REMOVING    EACH    MEAN    AND    SCALING 

C 

DO  2070  T=l,5 

AS=(  *SENS(  I  ,T*4-2)-AMEAN(T*2-l)+0.0  36)/0.006+0.5 
AN=(  SENS  I  I  ,T*»  )-AMEAN(  T*2)  +0  .036)  /O.  006+CK.  5_  _____ 

IF  ((AS.LT.l). CR. (AS.GT.ll) )  GO  TO  2060 

TRACE  (T,AS)=LTRS 
2060   IF  (  (AN.LT.l).CR.(AN.GT.U))  GO  TO  2070 

TRACE  (T,AN)=LTRN 

IF  (AS.EQ.AN)  TRACE  (T,AS)=STAR 

2070 CONTINUE  _   __ 

C 

C SET-UP    TRACE    F CR    All,     THEN    A12-A13 

C 

AS=( SENS!  I  ,22) -AMEANI 1 1  ) +0.36 ) /O. 06  +  0. 5 

IF  ((AS.LT.l). JR. (AS.GT.ll) )  GO  TO  2072 

TRACE(6,AS)=LT PS  _ 

2072   AN=( SENS( I ,24)-AMEAN( 1 2 ) +  0 .072 ) /O . 012+0. 5 

AS=l SENSl I ,26) -AMEAN( 131+0.072 )/0. 012+0^5 

IF( (AS.LT.l). JR. (AS.GT.ll) )  GO  TO  2074 

TRACE(7,AS)=LTRS 
2C74   IF  (  (AN.LT.  1).jP.( AN.^T.il))  GC  TO  2080 

TRACE(7,AN)=LI PN  

IF(AS.EQ.AN)  TRACE(7,AS)=STAP 
C 

C PRINT  DATA  (F.PST  POINT  OF  THE  RECORD  THEN  OTHER  63  POINTS) 

C        PRINT  64  PTi/REC  OR  I  PT/REC 

C 

2080       IF     (FPF.EQ.O)     GC    TO    2090 

C2080    IF     (FPF.EQ.O)     GC    TO    2100  1  PR  I  NT   T)NLY   "F I RST    POINT    OF    A    REXDRD) 

LSREC=RECN0-1 

WR  I  TECPRNTR 1,^201)    LSREC,     (TRACE (6 , J) , J=l , 1 1)  ,  (TRACE ( 7, J ) , J  =  l  , 11 )  , 

-  IWIDIP.IWIVE  L,(  ( TRACE ( T , J ) , J= 1 , 1 1 ) ,T=1 , 5 ) , IW 5DIR , I W5 VEL 

92  01       FORMAT     { IX,  «*•  ,  I  8  ,  2 ( 3X ,  11 Al ) , 3X , I  3  ,  IX , I  3, 5 ( 3X, 1 1 A  I ) , 3X , I  3, 1 X,  I  3) 

FPF  =  0 

GO    TO    2100 
2  09  0       WRITE! PRNTRl,^  202)     RELTIM, (TRACE (6, J ),J=l,ll),(TRACE(7,J),J=l,ll), 

-  IWlDIR,lWlVcL,l  (TRACE (T, J ) , J= 1 , 1  I ) ,T= 1, 5), IW 5DIR , I W5 VEL 
920?      FORMAT     ( 3X , F7. 2  ,2 ( 3X , 1  I Al ) , 3X ♦ I  3 , IX , I  3, 5 ( 3X, 1 1 Al ) , 3X, I  3, I  X,  I  3 ) 
2100      CONTINUE 

C 

C  PLOT    THE     13    ACCEL    1.0    INCH    APART     (FULL    SCALE) 

C  SKALE=1/SCAL E    PER    INCH 

C 
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LFVEL      21  MAIN  DATE    =    77146  19/42/33 

XX=2.0    +TINCM* (IREK-1) 
SKALF=THI /.Oi3 

00    400    KAC=itl3  _  _ 

YHl=13.4-KAC 

IF     (KAC.EQ.ll)  SKALE=THI/.120 

IF     < KAC.EQ. 12. 0R.KAC.EQ.13)  SKAL E=THI /.030 

CALL    PLOT     (XX,YHI,+3I 

IF  (IREC.GT.1J    CALL  PLOT  (  XX,  AL  AST  {  KAC  )  ,  *3) 

x=o.  

DC  353  1=1,64 

X=X*TINC 

Y=(SENS( I ,KAC*2)-AKEAN(KAC) )*SKALE 

IF  (KAC.GE.li. CR.NDIF.EQ.O)    GO  TO  340 

IF     (MODIKAC  ,2)  .EQ.O)  GO    TO    330 


C  SETUP    ODD    TkACES    AS    SUMS    AND    EVEN    TRACES    AS    DIFFERENCES 

C 

Y2=( SENS( I ,KAu *2+2 ) -AMF *N (K AC* 1) )*SKALE 
Y-Y+Y2 
GO    TO    340 
330    Y2  =  ( SENS( I , KA„ *2-2 J-AME *N { KAC-1 ) )*SKALE 

Y=Y2-Y 
34C    IF     (Y.GT.1.2)  Y=l.2 

CALL  PLOT  { XX* X,YHI+Y, +2) 
350  CONTINUE 

ALAST(KAC) =Y  ♦ YHI 
400  CONTINUE 
'550  "CONTINUE 
C 

SET  NEW  ORIGIN  FOR  NFXT  PAGE  OF  15  RECORDS 
C 

CALL  PLOT  (24.  ,0. ,-3) 
60C  CONT INUE 
"REWIND  10 
IFF  =  2 

GO  TO  1000 
C 

C ERROR  AND  END  PROCESSING 

C 

7C00   PRINT  9700 

9700   FORMAT! 'ABNORMAL  DATA  READ') 

GC  TO  2000 
8000   PRINT  9800 

9800   FORMAT  («  PROv.  ESS  I  NG  C  CMPLETE  •  ) 
CALL  PLOT (0., J. ,999) 
STOP 
END 
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PROGRAM  ACCSPC 

INTRODUCTION 

Program  ACCSPC  produces  multi-channel  acceleration  power 
spectra  from  data  recorded  at  the  Sitka,  Alaska  harbor  bridge. 

Program  ACCSPC  inputs  512  points  (approximately  35  seconds) 
of  acceleration  data  from  the  10  roadbed  sensors  as  well  as  towers 
A12  and  A13  along  with  calibration  data.  / 

Output  from  each  sensor  is  given  in  both  printed  form  and  a 
separate  Tektronix  plot  page  as  a  scaled  time  trace  and  frequency 
spectrum. 

In  addition  to  acceleration  values  and  spectra,  the  print- 
out contains  values  for  variance  of  the  acceleration  time  data 
and  the  sum  of  all  the  spectral  amplitudes  (SUMAMP)  for  a  channel 
as  verification  of  spectral  scaling  for  one-sided  PSD: 

SUMAMP  =  VARIANCE  *TSPAN  as  VARIANCE  and  TIMESPAN  are  para- 
meters of  the  time  series  data.   For  the  case  of  Sitka  data,  the 
sampling  interval  of  .07  seconds  means  512  points  represents  a 
time  span  of  approximately  36  seconds.   This  SUMAMP  then  is  a 
rough  measure  of  the  energy  observed  by  that  sensor  during  the  8 
record  interval  (36  second  time  span) . 

A  modified  version  of  ACCSPC  called  STPSPC  was  also 
developed  to  display  spectra  from  one  channel  for  many  succes- 
sive records  to  look  for  time  variations  in  the  frequency  com- 
ponents of  an  acceleration  event.   It  is  documented  immediately 
following  ACCSPC. 

See  Figures  7  through  15 ,  Table  4  and  Listings  2 ,  3  and  4, 


OPERATIONAL  NOTES 

The  maximum  amplitudes  for  both  the  time  traces  and  power 
spectra  may  be  set  by  the  card  input  values  'VSCAL'  and  'AMPMAX' 
respectively.   For  small  events  values  of  .015g  and  .0003  are 
commonly  used  while  for  larger  events  values  of  .0  3g  and  .0012 
are  more  appropriate.   A  default  value  is  provided  for  each  in 
case  the  card  input  value  is  left  blank. 

The  routine  SPCPWA  has  provision  to  input  the  title  for 
the  vertical  axis  of  the  spectrum  so  titles  other  than  'ACCEL 
SPECTRUM'  may  be  labeled  (if  used  for  displacement  data,  for 
example) . 
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Figure  7.   Program  ACCSPC  Setup 


22 


r      START       A 


0 


CALL  SITKA 
FOR 
CALIB 


READ 

REQUEST 

CARD 


YES 


0 


NO 


(    STOP     ) 


CONVERT 
DATA  PAIRS 

TO 
SUM  &  DIFS 


SET 

INDICES 


YES 


0 


PUT  A 
RECORD  INTO 
DATA  ARRAY 


READ 

A 

RECORD 


FILL  WORK 
ARRAY  PAIR 


PRINT 

FIRST  10 

POINTS 


CALL 

INTPWD 

FOR  W  &  W2 


0 


YES 


REWIND 
INPUT    TAPE 


Figure   8.      ACCSPC  Flow  Chart 
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Figure  9.   INTPWA  Flow  Chart 
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Figure  10.   SPCPWA  Flow  Chart 
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Table  4.   ACCSPC  Variable  Name  List 


Name 


Com 


Type 


Dimension 


Usage 


A 

AA1 

AA2 

ABEG 

AEND 

AINC 

AMP 

AMP2 

AMPMAX 

ARG 

XX 

AZERO 

BBEG 

BEGREC 

BEND 

BLANK 

BPER 

BPRR 

CCSIZE 

DASH 

DATA 

DT 

EM 

EYE 

FACTOR 

FREQ 

FREMAX 

I 

IBUF 

I  DATE 


R 

R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
I 
R 
I 
R 

R 
R 

I 
R 
R 
R 

I 
R 

R 
R 

I 
I 
I 


(2,^  passed) 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2060 
1 
1 
1 
1 
1 
1 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2000 
1 


Fourier  coefficients  array 

First  fourier  coefficient  of  a  pair 

2nd  fourier  coefficient  of  pair 

Window  height  at  start  of  data 

Window  height  at  end  of  data 

Printer  increment 

Amplitude 

Current  amplitude  to  test  for  max 

Max  value  of  spectral  plot 

Number  of  points  in  freq  spectrum 

Array  of  wave  numbers 

First  term  of  fourier  coefficient 

Fraction  of  window  to  taper  onset 

Requested  record  to  start  processing 

Fraction  of  window  to  taper  off 

Literal  blank 

Number  of  points  from  end  to  start 
last  taper 

Number  of  points  in  to  end  1st  taper 

Cal  comp  plot  size  factor 

Literal  - 

A  data  point  scaled  to  textwork  plot 

Sampling  interval  (here  .07  sec) 

Log  (base2)  of  ARG 

Literal  I 

Amplitude  compensation  factor 

An  individual  frequency 

Max  frequency 

General  index 

Plot  buffer  storage 

Date  of  input  tape 
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Table  4.   ACCSPC  Variable  Name  List  (continued) 


Name 


Com 


rpe 

Dimension 

i 

1 

i 

1 

i 

1 

i 

512 

i 

1 

i 

1 

i 

1 

i 

1 

i 

1 

i 

1 

i 

1 

i 

1 

R 

1 

I 

1 

I 

I 

1 

I 

1 

I 

73 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

R 

2060 

R 

R 

1 

Usage 


JERR 

IFF 

IM 

INV 

IPR 

IRF 

ISENSR 

ISR 

ISUB 

I  TAPE 

JP 

K 

KOL 

L 

LENG 

LL 

LSENS 

LYNE 

M 

N 

NDEG 

NN 

NOREC 

NP 

SNUM 

NTIK 

NUMLIN 

P 

PSIZE 

REC 


X 


Error  flag  return 

Tape  reading  function  flag 

NP  +  4 

Work  array  for  fourier  transform 

Trace  pair  being  processed 

Tape  reading  read  status  flag 

Channel  number  of  desired  sensor 

Cross  bridge  channel  to  match  ISEN3 

Channel  index 

Integer  tape  number  from  request  cd 

Position  within  lyne  of  a  printer 
plot  data  point 

Index  of  total  points  in  request 

Number  of  increments  across  the 
printer  plot  =  73 

Data  point  counter 

Number  of  points  in  the  time  trace 

Data  point  counter 

Instrument  label 

Line  array  for  printer  plot 

EM  truncated 

Number  of  points 

Degree  of  polynomial  to  remove 

Number  of  freq  points  per  spectrum 

Number  of  records  to  process 

Number  of  points  to  process 

Sum  and  difference  flag 

Number  of  record  tik  marks 

Number  of  lines  to  pint 

Array  of  data  points 

Final  textronix  plot  size 

Record  number 
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Table  4.   ACCSPC  Variable  Name  List  (continued) 


Name 

Com 

Type 

Dimension 

Usage 

RECNO 

i 

1 

Current  record  being  processed 

S 

R 

512 

Work  array  for  fourier  transform 

SAVEM 

R 

1 

Save  mean  value 

SAVEV 

R 

1 

Save  raw  valance 

SENS 

R 

64,37 

Array  containing  1  red  of  raw  data 

SENSR 

R 

1 

Sensor  number 

SKALE 

R 

1 

Scaling  factor  for  time  trace  plot 

STAR 

I 

1 

Literal  * 

SUMAMP 

R 

1 

Sum  of  amplitudes  within  a  spectrum 

TAPE 

R 

1 

Tape  number 

TAPENO 

I 

2 

Tape  number  literal 

TAPR 

R 

1 

Fraction  tapered  at  each  end 

TEKFAC 

R 

1 

Tektronix  plot  size  compensation 

TINC 

R 

1 

Plotter  increment  for  time  trace 

TINCR 

R 

1 

Plotter  spacing  per  red  of  data 

TITLE 

X 

I 

4 

Spectrum  title  literal 

TLEN 

R 

1 

Length  of  time  trace 

THI 

R 

1 

Height  of  VSCAL  from  baseline 

TMEAN 

X 

R 

1 

Mean  value  of  data  time  trace 

TSPAN 

R 

1 

Time  spanned  by  time  trace 

VARI 

X 

R 

1 

Variance  of  time  trace 

VSCAL 

X 

R 

1 

Vertical  scale  for  time  trace 

Wl 

R 

516 

1st , of  ..current  .trace  pair  to  process 

W2 

R 

516 

2nd  of  trace  pair  to  process 

WORK 

R 

512,12 

Temporary  work  array 

X 

R 

1 

Counter  for  X  axis  while  plotting 
time  trance 

XLOC 

R 

1 

X  offset  for  Tektronix 

XO 

R 

1 

Horizontal  offset  from  plot  origin 

Y 

R 

1 

An  individual  scaled  trace  value 

XT 

R 

1 

Counter  to  plot  record  tik  marks 
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Table  4.   ACCSPC  Variable  Name  List  (continued) 


Name        j  Com  Type 


YLOC 
YO 

ZEREO 
TTIME 


R 
R 
R 
R 


Dimension 


Y  offset  for  Tektronix 

Vertical  offset  from  plot  origin 

Frequency  increment 

TSPAN/2 
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LFVEL       21  HA1N  DATE    «=    771H  16/03/51 

*3******«s***$*  PROGRAM    ACCSPC  ♦s*©«**d**seac© 


TH15    PRCC-RAK       INPUTS    512    POIhTS    OF    ACCELERATION    DATA    FROM 
TEN    ROADBED    SENSORS    A*D    TOWERS    A12.A13    PLUS    CALIBRATION    DATA. 
EACH    SENSORS    DATA     IS    OUTPUT    (N    A    SEPARATE    TEKTRONIX    PLOT   PAGE 
AS    A    SCALED    TINE    TRACE    AAC    ACCELERATION    POWER    SPECTRUHe 

ROUTINES    CALLED:    SITKA,     1NTPWA,    SPCPWA 

PROC  .    BY    RAY    SLTUUDEH       S  .T  .A  .       12/12/72 
PCD  IF  3ED    BY    DUANE    NELSON    DURING    1915-1977. 


CGKNUK/EXPAP.H/ITAPEtBEGREC  tNSUH  ,AWPM Ax tVSCALtT  iTLE 

CCHMCN/iNPARH/CCiiIE.DT,LSENStT«EA^tVARI 

TIHEK SI  OK    DATA (512,12 >, Wl C5it i ,W2C5Ib j9  lfiUF(2000) 

REAL     S£NS(&4,37} 

INTEGER    TITLE  14) ,T AP ENL (2 } ,R ECNO , BEGREC 
C 

C  INITIALIZE    PROGRAM    ANC    DEVICES 

C 

CALL     PLOTS     (1BUF, 2000, fc) 

CALL     NEWPEN    (1) 

CCS12E=.80 

TEKFAC-1  .74 

PS1ZE=*CSIZF»TEKFAC 

CALL    FACTOR     (PSIZE) 

CALL    PLOT     (0.0,27.0,-3) 

CALL    PLCT(0.,0.,-3} 

DT    2L     1 =1  ,64 

DC    20    J  =  l ,37 
2C    SENSdt  J)=0. 

DT=.L7 

NCRFC=6 

NP=64*N0REC 

c 

C  READ    TAPE    NUMBER    CARD    AMD    1MT1M.UE    SENSOR    TABLE 

C 

IFF  =1 

CALL     SI TKA (IFF,- REGNO » I RF  s SENS  ,T AP EKD *  I  DAT E  J 
C 

C  REAP    DATA    REQUEST    CART 

C 

kEAD    50,ITAPE,bEGRtC ,NSUP  ,AMFMAX  ,VSCAL,(T ITLE  C  11  ,1=1,4) 
5C     FTR^AT     (315,5X,2F5.4  ,T41,4A4) 

IF     (AHPK^X.LT ..0001)  AKPHA*=.0C03 

IF     (VSCAL.LT..U0H  V5CAl=.G25 

PRINT    7  5,  ITAPEiSEGkEC  tNSUK  ,APPM>  VVSCAL 
75    FCRHAT     (•    TAPE=,,15,i    STARTING    RE C ■ t 1 5, 1 UX , »NSUM=  •  ,  11 , •    AMPMAX=», 
lFt.4f»    VSCAL  =  «  .F6.4) 
C 

C  SKIP     INTO    TAPE    THEN    READ    3t    SEC    CF     12     CFAN    OF    ACCEL     INTO    WORK 

C 

ACCSPC   Listing   2    (1   of    3) 
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LEVEL       21  HAIN  DATE    -    77166  16/03/51 

RECNL=BEGKEC 

1FF=2 

CALL     SITM(lFFaRECfC«!RF  •  SENS  ,T  AP  E*  D  .  ID  AT  E  ) 

c 

DO    ZbV    J=l,NOREC 

]  FF  =? 

CftLL     SIT*  AUFF.RECNC.lRF.SEKS.TAPEfcD.IDATE) 
C 

C  PIT    ALL    6    PAIRS    OF    ACCEL    DATA    IMTO    WORK    ARRAY 

C  64    PTS/REC    *    c071    SEC/PT    =    4.544    SfcC/RECURD 

C 

DC    240     !PR=1,6 

ISUP,  =  2*1PR-1 

ISEKSR=2*ISUE 

ISR  =  lSEN5R-»2 

IF     (IPR.L0.6)  lSEKSR=2t 

IF    (IPR.EC.6)  ISR=24 

DO    220     1=1,64 

K=K  +  1 

IF     (K.GT.NP)  CO    ID     2fcO 

IF     (NSUK.NE.O)  GLi    TO    212 

DATA (K, ISUfc  >=5fcNS  {i ,1 SENS*  i 

DATA (K,  JSUb*l )= SENS (1  ,I5R  1 

or    TL    214 
C 

C  SETUP    SITKA    ACCEL    SLH    t    D1FS    {  1  =2  ,3  =4  ,5-6  ,7-6  ,9  -10  . 1  3-1  2  J 

C 
212         DATA  (K,  ISUMsSENS  (1  9I  SENSR  !+5ENS(  I  slSRl 

t'«TA(K,  ISUb*l  )  =  SENSU  tlSEASRJ-SEhSUs!5R? 
214    IF     (DATA (K, ISUb  J .Ew  ,0.)  OAT  A (K ,  ISU t ) =0 =00000 1 

IF     CDATAlK,ISUc-*l>.EQ.O.  »         CAT A ( K, I  SUB*  1 1  =O.O000Cl 
220    CONTINUE 

K=K-t4 
240    CONTINUE 

K=K*64 
250    CONTINUE 
C 

2  60    CONTiNUC 
C 

C  PROCESS    I    PAIR    OF    CHANNELS    AT    A    1 IH  F    FUR    SPECTRA 

C 

a  L  C  C -i  «  C 

Yi  •.  i  r  -  l       .'i 
lu  v  -  i-  •  <. 

or  400  !Pp=i,6 

1SU^=IPR*2-1 
C 

C  SETUP     15R    FOR    THE    EVE N-fcUKt ER    ACCFLS     CN0R7HS1DE) 

C 

1SENSR=ISUL*2 

1SR=1SENSR*2 

IF     (IPP..LG.6)  15ENSR=2t 

1*     (1PR.EC.6)  1SR=24 

or    350    1=1, NP 

ACCSPC   Listing   2    (2   of    3) 
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LEVEL        ?1  HAJN  DATE    =    77166  16/03/51 

Wl  (  1  )=DATA(I,  ISUt  ) 
35C    fc2 (!  )=DATA  (1  .ISUB  +  1  ) 

PRIM    3  75,ISENSR,NP,BEGREC,Uim,l  =  lt10) 
375    FORMAT     (•lCHAN'.U,'     RLACY    FIR    1KTPWA    FDRB.ff15»a    PTS    STARTING    AT    RE 
KNL=,,I  5, AX,  'FIRST    10    POINTS    OF    RA*     DATA     FOLLOW  "a  SlOE  12  .4  ) 
C 

C  CALt      INTPWA    TP    PLOT    TIME    TRAC F    AND    SETUP     FOURJER    TRANSFORM 

C 

CALL     INTPWA     (  XL  DC  ,  YL Of  ,  1  SENS*  .fa 1  tNP } 
CALL     PLOT     (8.5,0. ,-31 
CALL     INTPWA     (  XL  PC  ,  YL  OC  ,  1  SR  ,Wi  ,NP  ) 
CALL     PLOT     (-6.5,-5.0,-3) 
400    CONTINUE 

REWU.D     1C 
900    CALL    PLCT(0  .0  ,0.0  ,999) 
STOP  99 

END 


ACCSPC   Listing    2    (3   of    3) 
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LEVEL       21  KAIN  OAT  E    *    7?1H  iS/0f/13 

SlBRCUT  1NE       I    MT    M    X 


THIS    IS    THE    INTERMEDIATE    ROUTINE    TC    PLOT    ACCEl    POWER    SPECTRA 
ROUTINES    CALLED    ARE:    DETRND,    WINDOW.    RHARM.    SPCPWA. 

PARAMETERS 

XLOC.YLOC-    STARTIBC    LOCATION    FOR    THE    PLOT    OK    PAPER 

ISENSR-   CHANNEL    NUMBER    OF   DESIRED    SENSOR 

WORK-    WORK    ARRAY.    TfcIS    ARRAY    MUST    SE    DIMENSIONED       10   LOCA 

LARGER    THAN    LERC. 
LENG-    f    OF    DATA   PNTS.    TO   BE   USED. 

MODIFIED    BY    DUAKE    NELSON    S.T.A.    11976)    FROM    WIND    SPECTRA   VERSION 


SUBROUTINE    1NTPWA     ULCC  ,  YLQC,  ISENSR  .WORK  .L  ERG) 

COMMON/ EXPA RM /I TA PE tB E GREC.NSUM, AM PM AX, VSCAL .TITLE 

CCMMON/INPARM/CCSIZE.CT.LSENS.TMEAfc.VAR  I 

DIMENSION    WORK(l) 

DIMENSION    INV(512).S(5121 

INTEGER    TITLEK) 

DATA    ABEG,AEKO,BBE&,BEND/.10,.10,.10,.10/ 

L5ENS=ISENSR/2 

TAPR-BBEG 

NPsLENG 

NNP=LENG 
C  M=8    (256)       FOR    36    SEC    SPECTRA       (JN^161 

ARG*NP/2 

EM=(AL0G10URG))/(AL0C10(2.))  « .1 

PRINT  165.NNP.EM.LSENS 
165  FORMAT  (///•  HHP^'ilS,*    fP^.F*.!,*  FOR  C*AR9.I3> 

M«EM 

1N=2*(2*«M)-K».<i9 

MDEG-1 

CALL    DTRND2    (WORK  (1 J .KNP.IIDEG .TNEAfe ,V &R I ) 

SAVEM-TMEAN 

SAVEV=VAR1 
C 

C      WINDOW  THE  DATA  ARRAY 

C        READJUST  AMPLITUDE  FOR  LOSS  TO  WINDOW  FUNCTION 
C 

BPRR=BBEG*NP*.5 

BPER=BEND*NP*.5 

CALL  WINDOW  (WORK  .WORK  ,NP .ABEG.BPR* .AEND.BPER I 

FACTORM./U.-TAPR) 

DO    300    Isl.NNP 
300    W0RK(1)=W0RKU  )*FACTOR 

CALL    DTRND2    (WORK  (1 ) .NNP.NDEG.TKE AN ,V AR 1 1 

TMEAN=SAVEM 
C  VAR1=SAYEV 

C 

C  PRINT    WINDOWED    TIME    SERIES    AND    SETUP    TO    PLOT    IT 

C  TRACE    OFFSETS    FROM    LOWER    LEFT    CORNER    OF    SPECTRUP    PLOT 

INTPWA   Listing    3    (1   of    3) 
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LEVEL       21  IRTPWA  DATE    *    77171  18/09/13 

C  XD    *    0.75    INCHES  TO    =   3.6    INCHES 

C 

PRINT    305 
305    FORMAT    f»    THE    FOLLOWING    DATA    IS    THE    ACCEL EROMET ER    TINE    TRACE    IN    G 
X    AFTER    WINDOWING    AND    REACT    FOR    FOURIER    TRANSFORMING") 

NUHLIN=NNP/10*1 

L  =  l 

DC  310  K=1,NUMLIN 

LL=L*9 

PRINT    315,CW0RK(l ),I=L,LL) 
310    L=L*10 
315    FORMAT     (•    •,10F10.<.) 

XC=.754XL0C 

Y0=3.6-»U0C 

TINC=.010/CCSI2E    •51Z/LE*Q      •DT/.01 

TINCR=T1NC«6<» 

TLEN=TINC»NNP 

THI=.25/CCSIZE 
C 

C  DRAW    FRAME    AROUND    TINE    TRACE    AND    ADD    RECORD    TIK    HARKS 

C 

CALL    PLOT     (TLEN*X0,Y0,*3) 

CALL    PLOT    tX0,Y0,42) 

CALL    PLOT     (X0,Y0*TH1  ,-»3) 

CALL    PLOT     |X0*TLEN,Y0-»THI,*2) 

CALL    PLOT     IX0*TLEN,Y0-THl,  +  3) 

CALL    PLOT     (XO,YO-TH1 ,421 

CALL    PLOT     (XL, YD, 43) 

XT=0. 

NT IK =8 

DC    330    1M.NTIK 

XT=XT4TINCR 
330    CALL    SYMBOL     (X04XT , YD-THI , . 14 ,13, 0. »-l> 

CALL    PLOT     |X0,Y0,43) 
C 

C  ADD    VERTICAL    AXIS    SCALE    VALUES    AND    SCALE    DATA    ACCORDINGLY 

C  USE    .25    INCH    «=    VSCAL  CDECK    DATA    USUALLY     .025    C> 

C 

IF     (1SENSR.GT.20)         V5CAL *VSC AL »2 . 

CALL    NUMBER    {  X0-.5  ,  YO«TH  I  ,  .  10  .VSC  AL  .0  .,  3  ) 

CALL    NUMBER    (XU- .5, YD -TH I  ,.10 ,VSC AL ,0 ., 3) 

CALL    SYMBOL     ( X0-.3 ,Y0  .  .  1C ,1HC ,0 . , 1 ) 

CALL    PLOT     tX0,Y0,43J 

5KALE  =TH1/VSCAL 

X=0. 

DO    350    1=1, NNP 

X=X*TINC 

Y=WORK( I)«SKALE 

CALL    PLOT     (XL.«X,Y04Y,42) 
350    CONTINUE 

CALL    PLOT     (X3tVLUC|43) 
C 

450    CONTINUE 
500    CONTINUE 


INTPWA    Listing    3    (2    of    3) 
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LEVEL       21  IHTPfcA  ©ATE    «    17171  18/09/13 

C 

C  COMPUTE    FOURIER    COEF.    THE*    CALL    TO    PLOT    SPECTRUM. 

C 

CALL    RHARM     CKORK f 1 1 9%  ,  IK  ¥  ,S  .1  ERR  J 
IF     (1ERR.NE.0I         PRINT    555.IERR 
555    FCRMAT     t lH 1 t20H INTPWR --R>  ARM    IERR  =  tl2) 

600    CALL    SPCPWA    ULOC tTLOC  ,WCRK  (1  )  , 1M J 
RETURN 
END 


INTPWA  Listing    3    (3   of   3} 
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LEVEL       21  MAIN  DATE    *    77173  15/13/42 

SUBROUTINE       S    P    C    P    W    A 


COMPUTES    AND    PLOTS    ACCEL    OR    DISPLACEMENT    POWER    SPECTRUM 

RCUTINES    CALLED?    NCNE 

PARAMETERS 

XLOC.YLCC-    STARTING    LCCATION    ON    PAPER 
A-    DATA    ARRAY    AS    RETURNED    BY     •RFARM* 

CONTAINING    N/2-2    tMCUE    COMPLEX    PCINTS 
FOP    35    SECOND    SPECTRA    HTF    DT=.CiSEC»    K=5U         SC    *N=25fc 

PROG.    BY    RAY    SOTOUDEH         S  .T  .#  .  2/7/74 

MODIFIED    BY    OUANE    NELSCN    CURING     1916,1977 


SUBROUTINE    5PCPWA     (XLEC  ,  UOC , A  ,N 1 

CCMMUN/ EXPARM/ 1 TAPE,BEGREC,NSUM,AMFM AX, VSCAL, TITLE 

CCMMCN/INPARN/CCSI2E  ,C T  ,1 5E N! ,TM E At  , V AR  I 

DIMENSION    A(2vl),LYNE(731,P(2  0€0)tJXXC2  06C) 

INTEGER    TITLEU) 

INTEGER    LYNE, BLANK, EYE ,D ASH  .STAR , JF 

INTEGER    BEGREC 

DATA    BLANK, EYE .DASh  .STAR  .KOL/1F     , IF  I  ,  1H - ,  1H» ,73/ 

AZERC=A(1,1) 

NN=N/2-2 
C        ZER0F=.0279  FOR  512  PT  136  SEC)  SPECTRA 

2ERDF=1  .C/f  IK-4)*DTI 

FREMAX=NN«2EROF 

TSPAN=(N-A)«DT 

TTIME=TSPAN/2. 

PRINT    75.N.DT.VAR1 
75    FORMAT    (•    N  =  »,U,«    DT  =  ,,f7.3,»    VARI*"  tF8.5 1 
C 

C  FIND    MAX.    AMPLITUDE    AND    5UN    CF    P.S.D. 

C  BUT    LIMIT    TO    INPUT    AMPMAX     IF    CONSTANT    SCALING    FOR    ALL    SPECTRA 

C 

AMP  =  (A(l,2)«A<la2)*A  (2.2  HAU.21MTT1ME 

SUMAMP=AMP 

DC    100    1=3, NN 

AMP2=(AC1,11*A(1,  I  )-»A(2,lI«A(2,I )     1«TT1ME 

SL'MAF*P=SUMAMP+AMP2 

IFCAMP2 -GT.AMP)   AMP=AHP2 
100  CONTINUE 

AINC=CK0L-1 I/AMP 
C 

C      PRINT  HEADING 
C 


DC  150  1=1, KDL 
LYNEt I  I=DA5H 
150   CONTINUE 

LYNE(l)  =EVE 
LYNE (KOL  )=EYt 
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LEVEL       21  SFCPhA  BATE    *    77112  15/13/42 

PRINT    155, ITAPE,6FGREC ,L SENS, AMP, LINE 
155    FCRMAT     (1H1 ,»TAPE=,,Ifc,»    STAfrTlNC    I  EC  =  %  !«  ,/,88X  »  «PCfc  ER    SPECTRUM', 
1/,*    INDEX      A    CLEF         B    CCEF  F .5 . ' ,6X ,  "PHASE  FRE0»,5X, 

21F0,3  7X,I3,27X,F9.fc,/,55»,7  3M) 
C 

C  BLANK    OUT    LYNE 

C 

DC    190    1=1, KDL 
LYNE ( I)=BLANK 
190    CONTINUE 
C 

C  COMPUTE    SPEC.    AND    PHA5E 

C 

DC    3C0     1*1, NN 
FREC=I*ZEROF 
AA1=A(1,1*1) 
AA2=A(2,I*1  ) 

A(l,l)=IAAl*AAl«AA2«AJ2)«TTlfE 
IF    (AA1.EQ.0.0)         AA1=.0C1 
IF    (AA2.EQ.0.0)  AA2=.0C1 

A(2,I)=ATAK2(AAl.AA2)«5  7.295l 
LVNE(1)=EYE 
LYNE (KOL )=DASH 
JP=AINC*A(1,1)*1.A999 
IF     (JP.GT.72)  JP  =  72 

LYNE(JP1=STAR 
C 

C  PRINT    A    AND    B    COEFS,     AMPLITULE    AND    PHASE, FREQ    AND    A    PLOT    VALUE 

C 

PRINT    255,I,(A(LL,I-»1),LL=1,2  J  ,(A(LL  ,1)  ,LL  =  1 ,2 )  ,FREO,LYNE 
255    FCRMAT     C1X  ,  K  ,2  C2X  ,F  7  .<•  I  ,1X  ,f  9  .6  , 1)  ,  F  8  .1  ,  IX  ,F9  .*.  ,  3X  ,73A  1 ) 

LYNE (JP  )=BLANK 
270    P(I)=A(1,I) 
300    CONTINUE 
C 

310    PRINT    315,AZER0,SUMAMF,TPEAN,V*RI  ,tECREC 

315    FCRMAT    C  •0A2ER0  =  ",F9.e  ,•    5UMAMF =•  ,F 1 1  .5  ,25X  ,  •    TME IN  =  • ,F10.6 , 

3t»    G  VARl  =  »,F10.t,»    C    STARTING    M    RECNC«.15) 

350    CONTINUE 

AMP=AMPMAX 

IF     (LSENS.GT.10 J         AMF=APP»2. 
IF    fNSUM.GE.l)  AMP=AMP«<.. 

DC    500    1=1, NN 
FREQ=I«ZERCF 

IF     (P(l  I.LE.O.O)  Ptl)=t.0CC01 

IF    CPU  I.GT.ANP)  P(I)=AMP 

AXX(1)=FREQ 
500    CCNT1NUE 

IF     IXLUC.LT.O.)  XL0(=Co 

C 

C  SET    SCALE    FACTUkS     IF1RST    VALUE,    DEtTAVl    FOR    CONSTANT    PLOT    SIZE 

C  FULL    SCALE    ACRDSS=    7    IhCH    -    1.14    Hi       513    SET     1    1 HCH    =    1.0    HZ 

C  2     INCHES    HIGH        tFLLL     SCALE)        =       INPUT     AMPMAX 

C 
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LEVEL       21  SPCPM  DATE    *    77112  15/13/42 

P(NN*1)=0.0 

P(NK*21=ANP/3. 

AXX(KN-»1)  =  .0 

AXX(KN*2)=1  .0 

IF     (1C0L  .LT.<i)  CC    TT    6CC 

*LMLIN=NK/10*1 

L  =  l 

OC    575    K=1,NU*L1N 

LL=L*9 

PRINT    56S,    |P(1 ),I=L  ,IL  ) 
565    FCRMAT     (•     »,10F10.6) 
575    L=L*10 
600    CONTINUE 
C 

C  PLOT    TITLES    THEN    SPECTRIN    CA1A 

C 

CALL     SYMBOL    (  XLOC  ,  YL  Of  -0  .4  •  .1<»  ,U  A  ,0  .  ■  1  ) 

SENSR=LSENS 

CALL    NUHfc  ER(  999. 0,999. C,.1<»,!EKSR, CO,- 1) 

CALL    SYMBOL     CXLOC  tUOC-t  .7 ,  .1  0  ,5F  T  J  Pfc*  ,0  .C  .51 

TAPE=ITAPE 

CALL    NUMBER    (999  .0  ,99<5  .C  .  .  10, TAPE  ,C  .  ,-1 ) 

CALL     SYMbOL     (999.0 ,999 .0, .10, 1CH  REC    t,C.0,lC) 

REC=eECREC 

CALL    NUKE  ER  ( 999.0, 999.  C..1C.R  EC  ,l.C,-l) 

CALL    AXIS     IXLOCYLLC, TITLE, H  ,3  .t  ,9C  .  ,P  (NK  «1 )  ,P(N  M2)  ) 

CALL    AXIS     (XLnC,YLOC,<.f-Ff>tC,-<i,'»"?.,0.,AXX  (KN-»1  J  ,AXXlhK«2)l 

CALL    PLOT     (XLOC, YLOC, "131 

DC    600    1=1, NN 

0ATA=P(1)*3./AMP 

IF    (DATA. GT. 3.0)         DATA=2.0 

CALL    PLOT    !XL0C*AXXU  J  ,  YLC  CH  AT  A  ,  ♦*  I 
800    CONTINUE 

CALL  PLOT  I0.,0.,43) 
900  RETURN 

END 
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PROGRAM  STPSPC 

INTRODUCTION 

This  program  is  a  modified  early  version  of  ACCSPC  that 
shows  spectra  from  only  one  accelometer  per  run  but  displays 
successive  spectra,  each  starting  several  seconds  later  in  time 
although  overlapping  information  with  previous  ones.   This  is  to 
show  how  frequency  components  at  a  specific  point  on  the  bridge 
change  over  a  period  of  approximately  two  minutes. 

Although  trials  of  this  program  have  shown  these  changes 
to  be  must  slower  than  anticipated,  it  is  documented  here  as  an 
extension  of  ACCSPC. 

Output  displays  include  Calcomp  plots  of  three  time  traces 
and  three  sets  of  acceleration  spectra  plus  printer  spectra.   The 
first  trace  of  three  represents  the  individual  sensor  chosen 
while  the  next  two  time  traces  and  spectral  sets  represent  the 
sum  and  difference  data  when  that  instrument  is  compared  to  its 
cross-bridge  sensor. 

To  keep  the  printed  output  from  being  usually  large,  a 
parameter  'NTH1  allows  only  every  8th  or  every  4th  spectra  to  be 
printed  out  in  full. 

See  Figures  16  through  18,  Table  5  and  Listings  5  through  7 

OPERATIONAL  NOTES 

Advance  =  1  record  (64  pts . )  =  12%  overlap  so  1024  pts . 
total  data  (71.7  seconds)  per  segment. 
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Table  5.   STPSPC  Variable  Name  List 
(New  Variables  not  in  ACCSPC) 


Name 


Com 


Type 


Dimension 


Usage 


ACl 

AC  2 

AC  3 

ADIF 

AIND 

ASUM 

COMPN 

DELX 

I  COL 

IFR 

ISUB 

J 

NADV 

NFR 

NPT 

NTH 

XLOK 

YLOK 


R 

R 
R 
R 
R 

R 
R 
R 
I 
I 
I 
I 
I 
I 
I 
I 
R 
R 


4100 

4100 

4100 

516 

516 

516 

3 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


Raw  data  for  individual  trace 

Raw  data  for  sum  trace 

Raw  data  for  difference  trace 

Work  array  of  difference  data 

Work  array  of  individual  data 

Work  array  of  sum  data 

Individual,  sum  or  difference 

Plotter  X  offset  between  spectra 

Current  plot  column  processing 

Current  frame  number 

Starting  point  within  large  arrays 

Counter  of  records  read  in 

Number  of  points  to  advance  next  step 

Number  of  spectral  frame  to  plot 

Total  number  of  points  to  read 

Only  print  spectra  for  every  Nth  frame 

X  offset  for  a  time  trace 

Height  of  a  time  trace 
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LEVEL      21  SI*  I*  BAIL    *    77167  OB/26/01 

*«•««•««•«****•  PROGRAM    S1PSPC  ••#••#»••*•«••• 


.  —  ^  «     . 


6ET    SPECTRUM    OF    1   ACCEL    CHANNEL    FOR    IFft    FRAMES 
AS    WELL    AS    SPECTRUM    CF    ITS   SUM    ANC    ©IF    FROM   OPPOSITE    SEMSOR 
EACH    FRAME    ADVANCES   NADV   PIS    IB    TIME 

ROUTINES    CALLED:    SITKA,    BTRRD2.    IRTPSS2.    SPCPW2.BLCCK   DATA 

FOR   FIRST   TEST   - 

ADVANCE-1   RECORD    164    PIS)    *    12%   CVERLAP 

50    1024   PTS   TOTAL    DATA    171.7  SEC!    PER    SEGMENT 

PROC.    Bt    DUANE    NELSON         3.TJ.         1976 

MODIFIED    FROM   AN    EARLY   VERSION    Of    ACCSPC. 


CCMMON/EXPARM/ITAPE»BECRECaNADV»AMPMAXaNFRvLSENS»»TH 

CCMM0N/INPARN/CQMPN(3l,IfR.lCOL.INEAN,VARI 

DIMENSION    AC1(4100),AC2I4100).AC3(4100)»16UFC2000) 

DIMENSION   A1N01516) .ASUM (516 I.ADIFI516) 

REAL    SENSt64,37i 

INTEGER    TAPEN0(2).RECRG.BEGREC 

CALL    PLOTS    !IBUF»?000t6J 

CALL    NEWPEN    11) 

CCSIZE-.30 

CALL    FACT0RICCSI2E) 

0T*.07 

■DEG=0 

■FR*24 

NIDV=64 

NTH*6 

c 

C  READ    TAPE   NUMBER   CARD    AND    INITIALIZE    SENSOR    TABLE 

C 

IFF*1 

CALL   SITKA    (IFF .RECNO.IRF .SERS.TAPENO .IDATE I 
C 

C  READ    DATA    REQUEST    CARD    FOR    Al«A3t   OR    AS 

C  (USE    ODD    NUMBERED   ACCELS   FRCM    SOUTH    SIDE   OF    SITKA    BRIDGE) 

C  FOR    NOW, USE    ISENSR    FOR    TAPE    OAK    LOCATION.    LSENS    FOR   ACCEL    TITLE 

C 

READ    (5,75!ITAPE,BEGREC,RFR,RADV.LSENS,AMPHAX 
75    FORMAT    (5I5,F5.4) 

IF    (AMPHAX.LT..0001)         ABPMAX =.0003 

ISENSR«LSENS«2 

PRINT    85tITAPE,BEGRECeNFReNADV, LSENS 
85    FORMAT    (•    TAPE=%15S*    BEGREC-*.  14  e9X .  •   NFR-*,12,B   NADV*'t13» 
1*   PTS    PER    FRAME    ON    A', 12! 
C 

C  EACH    FRAME   USES    512   PTS    (35   SEC) 

C  FOR    NADV-64    fl.O    RECI,    $ELX=0.5    INCHES 

NOREC=NFR    «8 

NPT«fc4«N0REC  STPSPC  Listing  5    (1  of  4) 
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LEVEL   21  MAIN  DATE  «  77161  ©8/26/61 

OELX=0. 

DELX*0.5«NADY/64 
C 

150  CONTINUE 
C 

C  SKIP    INTO    TAPE    TBEN    READ    4096    PTS    15NIN)    INTO    LARGE    ARRAYS 

C 

RECNC*BE6REC 

IFF»3 

CALL  SITKA  ! IFF 9RECND, IRF , SEN S9TAPEN0 , 1DATE J 

00  180  11=1,64 

DC  180  52=1.37 
180  SENSCI1,12)*0. 
C 

C  SETUP    1SR    FOR    THE    EVEIT-NUNBER    ACCELS    WORTHS  IDE  I 

C  64    PTS/REC    •    .071    SEC/PT    «  6.546   SEC/RECORD 

C 

1SR«ISEN5R*2 

*=o 

DO    250    J=1,N0REC 

CALL    SITKA    C1FF,RECNQ,IRF,SERS,TAPEN0,1DATE 1 

DC    220    1*1,64 

R=K«1 

IF    tK.GT.NPT)         60   TO    26C 

AC1(K)*SENSCI,1SENSR J 

SETUP    SITKA    ACCEL    SL'P    I    DIFS    Cl*2,l-2   OR    3*4,3-4    OR    5*6,5-61 

AC2(K)»SENS(I,ISEHSRft-iSEftS(S,iSR} 

AC3(K}sSENSCl ,ISENSR)-SERS(IflSR) 

IF    (AC1 (KI.EQ.O.)       ACltK!>0  .000001 

IF    (AC2CK).EQ.0.)       AC2(KL*0  .00000 1 

IF  (AC3SK)  .EO.O.)   ACS  <K  I -0.000001 
220  CONTINUE 
250  CONTINUE 
C 

260  CONTINUE 

REWIND  10 

PRINT  265, NPT ,BEGREC 
265  FORMAT  (•  READ  IN  AND  DETRND'.I5,e  POINTS  STARTINC  AT',15) 
C 

C        DTREND  THEN  PLOT  THE  3  ACCEL  TINE  TRACES 
C 

NDEG=1 

CALL  DTRN02  ( AC! I 1 ) ,NPT ,NDEG,THEAN,VAR I  J 

CALL  DTRND2  IAC2C 1 1 »MP T  ,RCEG ,TMEAN ,VAR  I  J 

CALL  DTRND2  (AC3 ( 1 1 ,NPT .NDEG.TMEAN ,VAR I  ) 

DC  500  IC0L=1,3 

XLOK=0.0 

c 

C  PLOT    BASELINES    AND   RECORD    TIK    NARKS    FOR    EACH  OF   TFE    3    TRACES 

C  T INC     IS    SPACING    BETWEEN    DATA    PTS    -    TINCN    IS    1    RECORDS    NORTH 

TIME    AXIS    *    100    PTS/INCH       (7.1    SEC/IN,    2.8    SEC/CR    ON    REDUCED    PLOT) 


tL0K=38.    ♦2.*C3-1C0L1 
CALL    PLOT     ULOK.YLOK  ,-3) 
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G  LEVEL   21  RAIN  DATE  *  77167  08/26/01 

TINC  =  .01C«2.5 

TINCR=TINC*64 

TLE*=T1MC*NPT 

TH1*.25/CCSIZE 

CALL  PLOT  «7LEN.D.s-»2) 

CALL  PLOT  I0.,0.,«2) 

CALL  PLOT  I0.,THI,«3! 

CALL  PLOT  CTLEN,THI,*2J 

CALL  PLOT  «TLEN,-THI.«3) 

CALL  PLOT  I0.,-THI,*2J 

CALL  PLOT  C0.t0.t«3> 

XT=0. 

NT1K=N0REC 

00  330  I*1,NT1K 
330  CALL  SYMBOL  (X T ,-TH I r .14 ,13,C « ,-1 J 

CALL  PLOT  C0.t0.t«3) 
C 

C  ADD    VERTICAL    AXIS    5CALE    VALUES    AMD    SCALE    DATA   ACCORDINGLY 

C  USE    .25    INCH    =    VSCAL         IDECK    DAT*    USUALLY    .025    CI 

C 

XT*XT*TINCR 

VSCAL'. 025 

IF    (ISEN5R.CT.20)         VSCAL *VSCAL«2 . 

CALL    NUMBER    C-.6.TH I  ,  .14  ,VSCAL ,0 . ,3 I 

CALL    NUMBER    C-.6 ,-TH I  ,  .34 ,VSC AL ,0 . , 3 I 

CALL    SYMBOL    I-.3 ,0. ,  .14.1H0 ,0 .,1 1 

IF    (1CQL.CT.1)         GO    TO    338 

SENSR=tSENS 

CALL    NUMBER    (-2 .5 ,0. •  .42,SENSR,0.,-1 1 
338    CALL    SYMBOL    1-2 .0 ,0 . » .42 .COMPNt 1C0L I ,0.,3 I 

CALL    PLOT    (0..0.»*3) 

SKALE=TH1/VSCAL 
340    X=0. 

IF    (IC0L.EQ.2)         GO    TO    360 

IF    (IC0L.EQ.3J         CO    TO    380 
C 
C  SCALE    AND    PLOT    THE    TIME    TRACES 


C 


DC    350    1=1, NPT 

X=X*TINC 

Y«AC1(1  MSKALE 

CALL  PLOT  (X.V,«2! 
350  CONTINUE 

GO  TO  400 
360  DC  370  1*1, NPT 

X=X«TINC 

Y*AC2(1)*SKALE 

CALL  PLOT  tX,Y,+2) 
370  CONTINUE 

£C  TO  400 
380  DC  390  1=1, NPT 

X=X*TINC 

Y=AC3U)*SKALE 

CALL  PLOT  IX,Y,*2J 


STPSPC  Listing  5  (3  of  4) 
51 


LEVEL   21  RAIN  DAIE  *  77161  09/26/01 

390  CONTINUE 
C        RESTORE  ORIGINAL  ORIGIN 

400  CULL  PLOT  I -XL OK ,-UOK  ,-J  I 
C 

500  CONTINUE 
C 

C        TRANSFER  A  512-PT  SEGMERT  AT  A  TIME  iKTO  SMALL  ARRAYS 
C 

NP«512 

OC    700    1FR*1,NFR 
XLQC=DELX*UFR-1I 
VL0O30.-IIFR«1.0I 
OC    570    1=1, NP 
ISUB'NADV«C1FR-1> 
AIND(I!*AC1U*ISUB) 
A5UP{1)'=AC2U*1SUB) 
570    AClFm-AC3Cl*!SUB) 

PRINT   575,1SENSR,NP,BEGREC,1SUB 
575    FORMAT    I •1CHAW* , 14, •    READ*    FUR    INTPWA    F0R*,I5.«    PTS   STARTING   AT    RE 
1CN0  * • . 1 5 ,9X , ■ ISUB  * • . 1 4  J 
ICOL--I 

CALL    INTPK2    CXLOC ,YLOC 8 I5ENSR ,AINO,RP I 
1C0L=2 

CALL    INTPW2    ( XLOC +21 . ,YLOC,ISENSV ,ASUM  .NP  I 
ICOLO 

CALL    INTPW2    (XL0C«54 . ,YLCC • I3ENSR ,ADI F.NP ) 
BEGREC=BEGREC*(NADV/6«M.01 
700    CONTINUE 
C 

900    CALL    PLOT  10. 0,0 .0,9991 
STOP  99 

END 
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LEVEL       21  MAIN  DATE    *    77261  08/26/01 

SUBROUTINE       1    N    T    P    W    2 


THIS    ROUTINE    DETRENDS    ANC   WIWD0W5    ACCEL    TINE    DATA    IN   PREPARATION 
FOR    FOURIER    TRANSFORM    TO    FREC    DOPAIN    BY    RHARN   AID   PLOT    BY    SPCPMA 
(THIS    IS   A    LIGHTLY    MODIFIED    VERSION    OF    WTPWA) 

ROUTINES    CALLED   ARE:    BETRRD.    NINDQM.    RMARN,    SPCPW2. 

I 
PARAMETERS 

SLOC.YLOC-    STARTIRC    LBCATIGN    FOB    THE    PLOT    ON   PAPER 

ISENSR-    SENSOR    NUMBER 

WORK-    WORK    ARRAY.    TM3    ARRAY    RUST    SE    DIMENSIONED      ID   LOCATIONS 

LARGER    THAN    LENG 
LENG-    f   OF    DATA   POINTS   TO   BE    USED. 


SUBROUTINE    INTPW2    (XLCC ,1L0C, ISENSR .WORK , LENG) 

COMMON/ EXPARN/I TAPE •6ECREC. NAD V.ANPM AX ,NFR,LS ENS .RTH 

C0MM0N/INPARH/COMPN(3S,IFRflCOLvTMEANvVARl 

DIMENSION    WORKll) .PI8C1 

DIMENSION    INV(5121»SC512) 

INTEGER    BEGREC 

DATA    ABEG,AEND,BBEG,BEND/.10,.10,.10..10/ 

NP=LENG 
6    TAPR»BBEG 
C 
C  M=8    C256J       FOR    36    SEC    SPECTRA       I1M»516) 

ARG=NP/2 

EN=(ALQG10CARGn/«AlOG10C2.M  4.1 

PRINT    75«LSENStC0MPN(IC0LlfXL0C»YLCC 
75    FORMAT    (///•    CHANNEL  ", 13 «A3 , •    BEINC    PROCESSED • ,5X  ."XLOC** .F6.2 , 
1"    VL0C*»,F6.21 

K  =  EM 

IN=2*C2*«M)*4.49 
C 

C  DETREND    TIME    DATA    AND    SAVE    THE   KfcAlt 

C 

NDEG=1 

CALL  DTRND2  IWORK  (II »RP , RDEG»TNEAN, VAR1I 

SAVEM*TMEAN 

SAVEV=VARI 
C 

C      WINDOW  DATA.  THEN  READJUST  AMPLITUDE  FOR  LOSS  TO  WINDOW  FUNCTION 
C 

BPRR=^BBEG«NP*.5 

BPER=BEND«NP*.5 

CALL    WINDOW    (WORK  .WORK tRP  ,ABEG,BPRR • AEND.BPER I 

FACT0R«1./U.-TAPR) 

DO    300    1*1, NP 
300    WCRMI)=WORK(I)*FACTQR 

CALL    DTRND2    ( WORK (1)  ,NP eNDEG.TMEAN.VARl I 

TMEAN*SAVEM 
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LEVEL       21  UTPN2  DATE    *   77141  OB/26/01 

C  VAR!*SAVEV 

PRINT    305 
30S    FCRNAT    (■    THE    F0LL0WIIC    OATA    IS    THE    ACCELERONETER    TIME    TRACE    IN   fc 
X    AFTER    WINDOWING    AND    REACT   FOR    FOURIER    TRANSFORM  1 AG*) 
C 

C  OMIT    PRINT    TINE    TRACE    EVERY    NT>    FRANE 

C 

IF     (*OD(IFR,NTHl.NE.O)         €0    TO    320 
NIMLIN*NP/10«1 
L  =  l 

OC    310    K»1»NUMLIN 
LL«L+9 

PRINT    315,(VORK(I  I.  I*L,LLI 
310    L«L*10 

315    FORNAT    (•    •.lOFlO.*) 
320    CONTINUE 
C 

500    CONTINUE 
C 

C  CONPUTE    FOURIER    COEF.    THER    CALL    10    PLOT    A    SPECTRUN. 

C 

CALL    RHARN    (WORK  1 1)  ,N  ,  INV  ,S tIERR ) 
IF    (IERR.NE.O)         PRINT    555.IERR 
555    FCRNAT     ( IH 1 r20H IWTPWR --RH ARK    1ERR*  ,121 

600    CALL    SPCPW2    4XL0C ,YLOC  ,WCRK (1  J , IN  I 
RETURN 
END 
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LEVEL       21  «MN  DATE    *   77161  08/26/01 

SUBROUTINE       $    P    C    P    H    2 


TMS    PROC.    COMPUTES    AfcC    PLOTS    POWER    SPECTRUM    FOR    ACCEL    DATA 
(THIS     IS    A    LIGHTLY    RGDIF1EC    VERSION    OF    SPCPWA) 

KOUTINES    CALLED;    NOME 

PARAMETERS 

XLOCTLOC-    STARTING    LGCAT10N    ON    PAPER 
A-    DATA    ARRAY    AS    RETURNED    BY     *RhARM' 

CONTAINING   N/2-2    UN1GUE    COMPLEX    POINTS 
FOR    35    SECOND    SPECTRA    WITH    DT*.01SECV    ««516         SC    ftft*256 


SUBROUTINE    SPCPW2    (XLOC .VLOC.A .HI 

CCHMCN/EXPAR»/ITAPE.BEGREC,NADV,AMPNAXrNPR,LSENS,«TH 

CCMM0N/INPARK/COMPNC3),IFR  tlCOL .TMFAN.VAR  B 

DIMENSION    A(2tl)tlNAME(ll»LYNE(73)    ,P (2060 ) ,AXX (2060) 

INTEGER    LYNE, BLANK tETE fD ASH .STAR , JP 

INTEGER  BEGREC 

DATA    BLANK, EYE. DASH, STAR.KOL/ll-     ,  »  1  .  1H- ,  1H*,73/ 

DATA    XL  .YL.YL2.FREMAX/2  5.0,6.0,4.0,5.0/ 

DATA    PNIN,PMAX,FRENIN,ANAl,AMIfc/-I80.0.180.0.0.0.€.C»0.0/ 
C 

C  INITIALIZE 

C  2EROF=.0279    FOR    512    PT     136    SEC)    SPECTRA 

C 

DT=.07 

A2ER0*A(1,1) 

NH=N/2-2 

2ER0F*1.0/CIN-41»DT) 

FREMAX=NN*2ER0F 

TSPAN*(N-41«DT 

TTlAE=TSPAN/2. 

PRINT  75,N,DT,VARI 
75  FORMAT  (•  K-',K,'  DT>,.F7.3.B  YARI=»,F8.5) 
C 

C      FIND  MAX.  AMPLITUDE  ARC  SUM  OF  P.S.D. 

C      BUT  LIMIT  TO  INPUT  AHPPAX  IF  CONSTANT  SCALING  FOR  ALL  SPECTRA 
C 

AMP  =  ( A  (  1  ,  2 )  «A  ( 1  .2 1  ♦*  1 2  ,2  I «A  (2  ,2  II  •!  T  I H  E 

SUMAMP=AMP 

DC  100  1=3. RN 

AMP2=(An.I)*A(l,I)«A(2«I)*A(2.1)  )*TTIME 

SUMAMP=SUMAMP*AMP2 

1FCAMP2  .GT.AMP]   ANP»ANP2 

ICO    CCNTINUE 

A!NC=(K0L-1 I/AMP 
r 

r  PRINT    HEADING 

C 

DC    150    E-I9KOL 
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LEVEL   21  SPCPK2  DATE  *  77167  96/16/01 

LYNE(I)=DASH 
150   CONTINUE 

LYNE(1)=EYE 
LYNE(K01)=EYE 

PRINT    155,ITAPE,BEeREC,L5ENS,C0NPNUCOLl,AWP.LYNE 
155    FCRHAT     f  1H1  ,-TAPE* ' • M , "    STARTING    REC =  • ,14, /.Bex*  'POWER    SPECTRUM", 
1/,"    INDEX      A    CDEF         t    COIF  P .5 . ■ 96X9 *PKASE  fREQ*,5X, 

21H0  ,34X  v  13  i  A3  ,27X  ,F9  .6  ,/  ,55X,73A1  > 
C 

C  BLANK    OUT    LYNE 

C 

00    190    1=1, KOL 
LYNE(I1=BLANK 
190    CONTINUE 
C 

C  COMPUTE    SPEC.    AND    PHASE 

C 

DC    300    1=1, NN 
FREQ=I«2ER0F 
AA1=A(1,I«1) 
A«2=A(2,I«1? 

IF    (AA1.EQ.0.0)         AA1=*001 
IF    (AA2.E0.0.0)         AA2=.001 
A(1,U  =  (AA1«AA1«AA2*AA2MTTIME 
AC2,l)  =  ATAN2  6AAl,AA2M5  7.295fi 
LVNE(11*EYE 
LYNE  (KOL  1=0  ASH 
JP=AINC«AQ,1 I ♦1.4999. 
IF    tJP.GT,72i         JP=72 
C 

C  ONLY    PRINT    SPECTRUM    EVER1    NTH    FRAHE 

C 

IF     CHOD  (1FR.NTH1.NE.0I         €0   TO    210 
LYNE(JP1=STAR 
C  PRINT    A  »B,SPECANPL,PFA5E 

PRINT    255,I,CA(LL,U11,LL=1,2),(A(LL,1),LL  =  1,2),FREQ,LYNE 
255    FORMAT     I IX , U ,2 <2X ,F7  .4 1  ,1X ,F9 .6, IX ,F8 .1 ,1X  ,F9  .4 • 3X  ,73A1 J 

LYNE  UP  1 'BLANK 
270    P(I )=A(1,!1 
300    CONTINUE 
C 

310    PRINT    315,AZER0,SU«AMP,TBEAN,VARI  ,BEGREC 

315    FORMAT     J ■CA2ER0= *  ,F9  .i  ,  •    SURftRP  =  B ,fll  -5 ,25X ,  •    TMEIN*%F10e6, 

X«    G  VAR|B°.Fi0.6.a    G    STARTING    AT    RECWC*,15i 

350    CONTINUE 

AHP=AMPMAX 

IF     CLSENS.GT.IO  1         ANP*APP*2. 
C  IF     (NSUH.EQ.ll  AMP=AHP«4. 

DC    500     1=1, MM 
FREG=I»ZEROF 

IF     (PMJ.LE.O.OJ  PC1UC.00001 

IF     (PU  1.GT.AMP1  Pill  -AFP 

AXXC1 )*FREQ 
500    CONTINUE 
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LEVEL   21  SRCPk2  DATE  «=  7716T         08/26/01 

IF  (XLOC.LT.O.)    XLOC-0. 

SET    SCALE    FACTORS    CFlffST    VALUEt    DELTAVJ    FOR    CONSTANT    PLOT    SUE 
FULL    SCALE    ACROSS'    14    IACH  =    1.14    HZ      SO    SET    1    IICH    ■    .50H2 
6    INCHES   HIGH       tFULL    SCALE)       *    INPUT    ANPMAX 

P(NN*1)*0.0 

P(NN*2»*ANP/6. 

AXX(NN«1)=.0 

AXX(NN«2)=.50 

IF    (IC0L.LT.4)         GO    TO    600 

RUMLIN*NN/10*1 

L*l 

DC    575    K«1,NUNLIN 

LL=L«9 

PRINT  565,  CP(II,I*L,LL) 
565  FORMAT  I"  a,10F10.6! 
575  L*L«10 
600  CONTINUE 
C 

C      PLOT  TITLES  AND  AXES 
C 

CALL  SYMBOL  CXLOC  ,Y10C-  0.5,  Jl  ,4HRE  C  ,0.»4l 

REC=BEGREC 

CALL    NUMB ER  1999.0  ,999.0,- 21  ,1  EC ,0.C,-1) 

IF    UFR.LT.NFRJ         GO    TO    640 

CALL    SYMBOL    1999. ,999 . , .21 ,6*    TAPE=,0.0,6) 

TAPE'ITAPE 

CALL  NUMBER  (999.0,999 .0, .2 1, TAPE ,C .,-1 ) 

CALL  SYMBOL (999 .0,999.0,. 21 ,9H  SENSOR=A  ,0.0.9) 

SENSR*LSENS 

CALL  NUMB ER (999 . 0,999. Cr. 2 1,SE*SR,C. 0,-11 

CALL    SYMBOL    (999. ,999. , .21,C0MPN( ICOL I ,0.  ,3) 

GO    TO   660 
660    YT*-1.0 

OC    650    1*1,7 

YT*YT*1.0 
650    CALL    SYMBOL    iXL0C*14  .  .YLBC+YT , .14 ,13 ,90 .,-1 1 

GO    TO    664 
660    CALL    AXIS    CXL0C«14. , YLCC .84HICCEL    SPECTRUM ,-14  ,6  . C.90  .0,P  (NM1 5  , 

/P(NN«2) 1 
664    IF    (IFR.EG.NFR)         GO    TO    680 

XT=-1.0 

OC    670    1=1,14 

XT-XT+1.0 
670    CALL    SYMBOL    (XLOC«XT ,tL0C • .14 ,13,0. ,-1 1 

GC    TO    690 
680    CALL    AXIS    (XLOC ,YLQC.4HFREQr-4,14 .,0. ,AXX CNN«1 ) •AXXCMN*?)) 
C  KAVBE    LINE    NEEDS    XLCC,YL0C=O. 

690    CALL    PL0T(XL0C,YL0C,-3» 

CALL   LINE    CAXXdl  ,PC1!  ,NN  ,1  ,0  ,01 

CALL    PLOT    I-XL0C-YL0C-3I 
900    RETURN 

END 
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LEVEL   21  BLK  BATA  DATE  *  77144  21/99/35 

BLOCK  OATA 

COHKDN/!NPARH/COHPN(3!.1FR,ICOL»T*EAI,VA8! 
DATA  C0HPK/3HlND,3HSUP,3hDlF/ 

END 
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PROGRAM  CALF I L 

INTRODUCTION 

This  program  creates  a  channel  calibration  file  for  the 
Newport  and  Sitka  instrumentation  configurations.   Other  process- 
ing programs  using  bridge  data  may  then  access  this  file  on  the 
FHRS  disk  library  in  conjunction  with  the  tape  reading  routines 
SITKA  or  NEWPORT  so  that  each  record  read  then  provides  calibrated 
acceleration  or  wind  data. 

Each  channel  has  its  set-up  cards  in  chronological  order 
showing  each  time  a  calibration  value  changes  or  a  replacement 
or  repair  was  done  to  its  circuit.   Any  particular  user  run  then 
picks  up  the  card  appropriate  to  that  particular  date  for  each 
channel. 

See  Figures  19  and  20,  Table  6  and  Listing  8. 

OPERATIONAL  NOTES 

Essentially,  once  this  file  is  placed  onto  the  DOT  disk 
library,  it  is  only  rerun  when  new  channel  calibration  update 
cards  need  to  be  added. 
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CALIBRATION 
CARDS 


UNIT  5 


CALFIL 


^  UNIT  11 


(DISK  LIBRARY 
STA  CALFIL [ 


Figure  19.   Program  CALFIL  Setup 
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Figure  20.   CALFIL  Output 
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Table  6.   CALFIL  Variable  Name  List 


Name 


Com 


Type 


Dimension 


Usage 


CALFIL 

CARDIN 

CTTANO 

DATE 

I 

II 

INCHAN 

INDATE 

INN  AM 

INRMKS 

INSITE 

INS LOP 

INYINT 

LINES 

NAME 

SLOPE 

TAPENO 

YINT 


I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
R 
R 
I 
I 
R 
I 
R 


1 

1 

70 

1 

1 

1 
1 
1 
1 
5 
1 
1 
1 
1 
7 

70 
2 

70 


Calibration  file  unit  number 

Card  input  unit  number 

Channel 

User  date 

General  Index 

I  S  35 

Calib  channel  number 

Calib  card  date 

Calib  name  of  instrument 

Input  remarks 

North  or  South  side  of  Bridge 

Calibration  slope 

Calibration  Y  intercept 

Line  counter 

Sensor  name 

Slope 

User  tape  number 

Y  Intercept 


62 


LEVEL      21  NA1N  DATE    *    7G098  17/22/03 

*ee»*PR0GRAM    CALFIL*******************  *e  ft*  *$*♦««*••*»*•**  »**s»*»ee****»»»*3»**e 

CREATES    CHANNEL    CALIBRATION    FILE    FDA    NEWPORT    AND    SITKA 

INSTkUMENTATl ON    CONFIGURATIONS 


LOCAL    VARIABLES 


REAL     IN  SLOP, I  NY! NT, SLOPE  < 70), TINT  J  70 J 

INTEGER    CARCI N,C A LF I LVI •! i .LINES, INCH  AN fINNAK.l NSITE* INDITE t 

-  1NRMKS(5),CHAN0(70),NANE(7)  ) .TAPE NO  (2 ) , DATE 
DATA    TAPENO/'CALT'.'ST       */ 

CARD1N=5 
CALF1L=11 
DATE=0 
1=0 
PRINT    9000 

9000  FORMAT    I1H1) 
LINES=0 

10  REAU(CARD1N,9001,END=30)     INCH  AN ,1 NNAH , INSLOP, I NYI  NT ,1  NSI  TE  , 

-  INDATE, INRMKS 

9001  FORMAT    1 1 2  , T 1 1 , At  ,T21  ,F8 .* ,TI 1 ,FS .* ,TU , Al , T51  , 15 ,Tfcl ,Slt I 
NRITEICALFIL,9001 )    I NCHAN ,1 N* AM .INSLOP , I NYI NT , I NS IT E, INDATE , 

-  INRMKS 

1F(  INDATE. GT.DATE  )    DATE*INDATE 
1FIINCHAN  .E3.I)    GO    TO    20 
PRINT    9002 

9002  FORMAT    11H    ) 
IINES=LINES*1 
1  =  1*1 

IFtLlNES.LE.50)    GO    TO    20 
PRINT    9000 

L1NE5=0 
20  PRINT    9003, IMCHAN, INNAM, INSLJP, IHYINT  , INS ITE, INDATE, INRMKS 

9003  FORMAT     C1X,  12  ,2X,  A4,2X  ,F8  .4  ,>  X,F8  .4  ,2X,  Al  ,2X  ,  15  ,2X,5A4  I 
L1NES=LINES*1 

CC    TC    10 
30  ENDF1LE    CALF1L 

REK1ND    CALFIL 
C 

C SET-UP    CHANNEL    CALIBRATION    TABLE 

C 

1=0 
40  READ(CALFIL,?00I,END=50)     INC i AN, I NNAM , I NSLO9 • 1 H YI NT , I  MS  I T 5, 

-  INDATE, INRMKS 
IFUNCHAN.GT.I  >     I  =1  -U 
IF11NDATE  .GT.DATE)    GO    TO    40 
CHAN0(I*11=IMCHAN 
NAME(I*1)=1NNAM 
SLQPE(M1)  =  IN5L0P 
YINT(I*1)=!NYINT 

GO    TO    40 
C 
C PRINT   CHANNEL    CALIBRATION    TAJLE 


C 


CALFIL   Listing   8    (1   of    2) 
63 


LEVEL       21  MAIN  DATE    *  7*098  17/22/0& 

PRINT    9004,    TAPMO.DATE 

9004  FORHATUhl,         //T26,» CHAN1EL    CALIBRATION    1ABLE «/T32, 

l'TAPL    NUMBER    •  .2AW  T34  ,  •»FCO*DED    NI5,       ///2  C5X,  »CHAN  •,  2X  , 
2«SENSDR»,4Xf» SLOPE* ,5X ,»Y-I  NT P if  it , 74 { •  -•  )//| 

DO    55    1=1  ,35 
II=I«35 

PRINT   9005,CMANO(I  )VNAME  U)  .SLOPE  UI.YINT  CI  I,  CHAN  Oil  I  I,NA«E(1  lj, 
1    SL0PEI1 1  )  VY1 NT (1 1) 

9005  F0RMAT(2X,2(4X,12,4X.A4,3X,F3.4t3XtF6.*)) 
55  CONTINUE 

STOP 
END 


CALFIL   Listing    8    (2    of    2) 
64 


PROGRAM  COPY 


INTRODUCTION  &  OPERATIONAL  NOTES 


This  program  copies  specified  records  of  an  entire 
file  from  one  tape  to  another.  The  file  numbers  for  both  tapes 
are  specified  in  the  JCL  cards  for  program  copy  while  specified 
start  and  stop  record  numbers  for  the  copied  tape  are  given  on 
the  copy  data  request  card. 

See  Figures  21  and  22,  Table  7  and  Listings  9  and  10. 
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Figure  21.   COPY  Flow  Chart 
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Table  7.   COPY  Variable  Name  List 


Name 


Com 


Type 


Dimension 


Usage 


BEGKEC 

DATA 

DUM 

ENDREC 

I 

NDATA 

NSKP 

NULL 

TAP  IN 

TAPOUT 


1 
562 

1 

1 

1 

1 

1 
562 

1 

1 


Beginning  record  of  request 

Data  array 

Dummy  variable  for  read 

Ending  record  number 

General  index 

1  record  past  ending  record 

Number  of  records  to  skip 

Null  array  for  dummy  record 

Tape  unit  for  input 

Tape  unit  for  output 
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LEVEL   21  HAIN  DATE  «  77132  15/53/22 

*$**spPOGRAM  C0PY***«(SITK*  VERS1CN) «**« *•»«*« * *«•««*» ««•*• »»«••«***••« 


CCP1F5  SPECIFIED  RECORDS  FORM  ONE  DEVICE  TU  AWOTHER.   IF  COPY 

REQUEST  IS  BLANK,  ENTIRE  FILE  15  CCPIED. 

LCCAL  VARIABLES 

INTEGER  TAPINfTAPnUT,BE&REC,ENDREC,DUH,I,CATAC562I,NULLf562> 

INITIALIZE 


NREC=1 

TAPIN=10 

TAPOUT=12 

DC  5  1=1,562 

NULLU  )=L 
5      CONTINUE 
C 
C READ  COPY  REQUEST 

REAC  90CC,  BE6REC  .ENDREC 
C 
9C00   FCRMAT  (15, Til, 15) 

1F(PEGREC  -LE.l)  GO  TO  40 
C 

C SKIP  TU  BEGINNING  RECCRD. 

C 

NSKP=BEGREC-1 

DC    30     1=1  ,NSKP 

READ  (TAPIN,9001,FND=1G,ERR=20)  DUP 
SC01   FCRMAT  (Al) 

GC  TC  30 
10     PRINT  90C2.I 
9002   FCRMAT  (•  ECF  ENCOUNTERED  WHILE  SKIPPING.   RECORD  NO.  %I5, 

-  •  PROGRAM  T  ERH1NATEC  .•  1 
STOP 

20     READ  (TAPIN.900I)  DUM 

PRINT    9003,1 
S003       FCRMAT     {■    I/O    ERROR    EKOLNTE    D    WHILE    SKIPPING.    RECORD    NO.    8,15, 

-  ■    PRUGRAM    CONTINUING  .•) 
30            CONTINUE 

C 

C CCPY  SPECIFIED  RECURD5 

C 

40     PRINT  9CL8, BEGREC 

900*   FCRMAT  fe  COPY  BEGINNING.  RECORD  NC.  %J5,»  FIRST  RECORD.*! 

1F( ENDREC  .EQ.OJ  ENuREC=99999 

NCATA=ENDREC-»1 

DC  9L  l=fc FGREC .NDATA 

RFAD(TAP1N,9004,END=7C,ERR=8C)  DAT* 
9004   FDRMAT  (56 C 10 A4 ) , A4 , A  3  ) 

WRITE  (TAPUUT  ,9004)  DMA 

GO  TO  9C 
70     ENDFILE  TAPDUT 

REWIND  TAPUUT 

COPY  Listing  9  (1  of  2) 
69 


LEVEL   21  HIIN  DATE  «  77132  15/53/22 

REWIND  TAP1N 

PRIf.'T  9CC5.1 
9CC5   FCR*AT  (•  E  PF  ENCPUNTEREE  WHILE  COPYING.  RECORD  NC  •, 
15,  •  PROGRAM  TERH1HMEC  .*  ) 

STOP 
8C  WRITE  (TAP3UT  ,9004)  HULL 

READ(TAPIN,9001 )  DUH 

PRINT  9CC6.I 
9C06   FCRHAT  ('  I/O  ERROR  ENCOUNTERED  WHILE  COPYING.  RECORD  NO.  ■ 

-  ,15,'  NULL  RECORD  INSERTED?  PROGRAM  CONTINUING.*) 
90     CCNT1NUE 

PRINT  9CC7.I 
9007   FCRMAT  (•  COPY  COMPLETE.  RECCRC  NO.  '.IS,1  LAST  RECORD.  •) 

ENDF1LE  TAPDUT 

REWIND  TAPLUT 

REnlND  TAP1N 

STDP 

END 


COPY  Listing  9  (2  of  2) 
70 


COPY    BEGINNING*    RECORD   NO.         608    FIRST    RECORD. 
— Q&PX    CQHR4. Elt^ -R«OR© -NO  ,  — £0M  -LAST    RECORD  s 


COPY   Listing   10 
.__       71 


PROGRAM  DBLINT 


INTRODUCTION 

Program  DBLINT  reads  acceleration  data  from  Sitka  tapes 
and  converts  it  to  velocity  and  displacement  data  by  filtering 
and  demeaning  to  remove  bias  to  allow  proper  integration  by 
the  trapezoidal  rule.   This  data  may  optionally  be  plotted  as 
full  length  time  traces  before  being  fourier  transformed  for 
plotting  as  frequency  spectra  8  records  (36  seconds)  at  a  time. 

See  Figures  23  through  30,  Table  8  and  Listings  11-16. 

OPERATIONAL  NOTES 

To  test  the  useability  of  the  acceleration  data  an  option 
is  available  to  print  out  many  pages  of  the  running  mean  for 
each  trace.   Because  of  the  many  pages  of  extra  printout  this 
option  is  only  used  occasionally  when  deemed  necessary  on  a 
particular  event.   To  have  this  running  mean  printed  set  the 
input  parameter  'OSPEC'  =  0  instead  of  the  normal  value  of  1. 

The  sensor  number  requested  is  the  tape  channel  itself, 
not  the  instrument  designation.   For  example,  a  request  for  '22' 
gives  All  data  but  remained  printed  out  as  '22.'   Similarly  for 
A6  data  request  ISENS  =  12. 
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Figure  23.   Program  DBLINT  Setup 
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Figure  24.   DBLINT  Flow  Chart 
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Figure  25.   TTRACE  Flow  Chart 
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Figure  26.   SPECT  Flow  Chart 
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Table  8.   DBLINT  Variable  Name  List 


Name 


Com 


Type 


A 

AO 

Al 

A2 

A3 

A4 

A5 

AA 

AAO 

AA1 

AA2 

AA3 

AA4 

AA5 

AFS 

AMP MAX 

AS 

AVGFS 

Bl 

B2 

B3 

B4 

B5 

BBO 

BB1 

BB2 

BB3 

BB4 

BB5 

BEGREC 

BIAS 


Dimension 


R 

Passed 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R 

1 

R 

1 

R 

1 

R 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

R*8 

1 

I 

1 

R 

1 

Usage 


Input  Data  Array 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Normalization  Factor 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Running  Average  of  FS 

Max  Value  of  Spectral  Plot 

Absolute  Value  of  S(I) 

Average  Value  of  FS  Data 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Final  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Initial  Value  Filter  Coefficient 

Beginning  Record 

Data  Bias 
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Table  8.   DBLINT  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


BLNK 

C 

CCSIZE 

CHANO 

D 

DELTAV 

DS 

DT 

ENDREC 

FC1 

FC2 

FILE 

FIRS TV 

FS 

FXLOC 

FYLOC 

I 

IBEG 

IBUF 

IEND 

IFILE 

II 

IM 

INC 

INT 

INTEG 

IP 

IRF 

ISENS 

ISF 

ISPEC 


I 

1 

R*8 

1 

R 

1 

I 

1 

R*8 

4000 

R 

1 

R 

Passed 

R 

1 

I 

1 

R 

1 

R 

1 

R 

1 

R 

1 

R 

3200 

R 

1 

R 

1 

I 

1 

I 

1 

I 

4000 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

I 

1 

Literal  '  ' 

Polynomial  Argument 

Cal  Comp  Plot  Size  Factor 

Channel  Number 

Work  Array 

Plotter  Increment 

Displacement  Data  Array 

Sampling  Interval 

Ending  Record 

Low  Cutoff  Frequency 

High  Cutoff  Frequency 

File  Number 

First  Value  to  Plot 

Filtered  Data 

Plotter  X  Avis  Offset 

Plotter  Y  Axis  Offset 

General  Index 

Beginning  Record 

Plot  Buffer  Storage 

Ending  Record 

File  Number 

General  Index 

Counter 

Increment 

Integration  Counter 

Plotting  Parameter 

Printer  Position  of  Data 

Read  Status  Flag 

Sensor  Number 

DDTRND  Intial  Entry  Flag 

Processing  Options  Flag 
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Table  8.   DBLINT  Variable  Name  List  (continued] 


Name 


Com 


Type 


Dimension 


Usage 


I  TAPE 

K 

KK 

LAST 

LENGTH 

LINTYP 

LOW 

LSENS 

LSTRT 

LTRI 

M 

N 

N2 

N6 

NDEG 

NF 

NSEC 

NT 

NTIMES 

PI 

PLTl 

PLT2 

PLT3 

PLT4 

PPR 

REC 

RLRGST 

S 

S12 

SCL 

SENS 


I 
I 
I 
R 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
R 
I 
I 
I 
I 
I 
R 
R 
R 
R 
R 
R 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

10 

10 

10 

10 

1 
1 
1 

3200 
3200 
1 
64,37 


Tape  Number 

General  Index 

General  Index 

Last  Value  Processed 

Sub  Internal  For  Integration 

Plotting  Parameter 

Low  Cut  Filter  Option 

Sensor  Number 

Start  of  Integration  Interval 

Literal  'I' 

General  Index 

Number  of  Points  to  Process 

N/2 

N+5 

Degree  of  Polynomial  to  Remove 

Number  of  Points 

Number  of  Seconds 

Ending  Point 

Number  of  Times  to  Integrate 

3.14159 

First  Printer  Plot  Array 

Second  Printer  Plot  Array 

Third  Printer  Plot  Array 

Fourth  Printer  Plot  Array 

Number  of  Points  Per  Record 

Beginning  Record 

Largest  Value  of  S  Data 

Main  Data  Array 

Acceleration  Data 

Scaling  Factor 

1  Record  of  Raw  Data 
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Table  8.   DBLINT  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


SINC 

SMAX 

STAR 

SUMI 

SUM2 

TAPE 

TAPENO 

TEMP 

TICK 

TITLE 

TMEAN 

TTL 

VARI 

VAXIS 

VS 

VSCAL 

Wl 

W2 

W3 

X 

XEND 

XINC 

XLOC 

YLOC 


R 
R 
I 
R 
R 
R 
I 
R 
R 
I 
R 
I 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 
R 


1 

1 

1 

1 

1 

1 

2 

1 

1 

4 

1 

8 

1 

1 
Passed 

1 

516 

516 

516 

4000 

1 

1 

1 

1 


Plotter  Increment  Between  Seconds 

Max  Data  Value 

Literal  '*• 

Sum  of  Velocity  Data 

Sum  of  Displacement  Data 

Tape  Number 

Tape  Number 

Temporary  Max  Value 

X  Location  of  1-Second  Marks 

Spectrum  Title  Literal 

Mean  Value  of  Time  Trace  Data 

Input  Spectrum  Titles 

Variance  of  Time  Trace 

Distance  Between  Data  Traces 

Velocity  Data  Array 

Vertical  Scale  for  Time  Trace 

Velocity  Data  Work  Array 

Displacement  Data  Work  Array 

Acceleration  Data  Work  Array 

Array  of  X  Axis  Plotter  Value 

Last  Value  of  X 

Plotter  Increment  Between  Data  Pts, 

Plotter  X  Location 

Plotter  Y  Location 
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LEVEL       21  MAIN  DATE    «    77229  18/20/34 

C  sjtj«ts84««*t  PROGRAM    DELINT  •«**«•••»•**  ***** 


r 


C  THIS  -PROGRAM  READS  ACCELERATION  DATA  FROH  SITKA  TAPES  AND  CONVERTS 

C  IT  TO  VELOCITY  AND  DISPLACEMENT  DATA  BY  FILTERING  AND  DEMEANING 

C  TC  RtHUVfc  PIAS  FOR  PRCPEP  INTEGRATION  BY  TRAPE20ICAL  RULE. 

C  THIS  DATA  MAY  BE  PLOTTED  AS  TIME  TRACES  OR  FOURIER  TRANSFORMED 

C  THEN  PLLTTED  AS  FREQUENCY  SPECTRA. 

C 

C  RTUT1NE5  CALLED:  T AP E  ,C L E AN  ,LDTRN D  ,SP E CT ,TTRAC E 

C  <ALSC  NEEDED:  I N TP WA  ,SPCP WA ,S iTK A  ) 

c 

C  PROG.    eY    D0LLY    GREENE       S.T.A.       197fc-1977 

c 

DIMENSION  1BUF(2C00) 

RFAL  S(320CJ),FS{32u0),512(32C0)#LAST 

INTEGER    STAR.PLNK.LTRI  .PLTHJOJ  .PLT2t  10)  ,PLT3(10]  VPLT4  (10) 

INTEGER    I EGREC 

DATA   -STAP.BLNK.LTRl  /»•",•     Sfls/ 

CCMMLN/EXPARM/lTAPE.BECRECtNSUM, A M FH A  X , VSCA L  ,T 1TLE 

Cr.M.vPN/lNPARM/CCSIZE  ,DT  fISENS  tTK  E  AN  ,V  AK  1 


C 

CALL    PLDT5UPUF,  2CO0t6) 

CALL     NE*PEM1) 

CCSIZE=1.3 

CALL     FACTOR(CCSIZF) 

CALL     PLOTIO  .,27. ,-3) 

L»P    11     1=1,10 

PLT  I  (  J  }  =L  L  NK 

PLT2  U  )=PLNK 

F  L T  3  C  1  )=fcLNK 

H L  T  i,  <  I  )  =t-  L  NK 
11  CCSTlNUE 

PLT1 (5) =LTRI 

FLT2(5) =LTP  I 

PLT?(5) =LTP 1 

PLT<,  (?)  =  LTR  J 

P  I  =3  .l^H  92653b 

PEAD'ih ,9C00)     I TA  PE ,  IF  ILL  .  I  SENS, I  BEG, I  END  , I  SPEC  ,FC1  ,FC  2 

WRITE*  (t  ,9  000)     J  TAPE,  IF  1LE  ,1  SE  NS  ,  I  P.  EG  ,  1  END  ,  ISP  EC  ,FC1  ,F  C2 
900C     FORMAT     (b  15  ,2F5  .2  ) 
910  1        FTR'MT  I  5X,  »VEL  .HE  AN     I  5  "  ,F  10  .6  ,5X  ,  14  ) 
C 

C ISPEC=0    GIVE     PUNNING    *EAN    UUTPUT     AND     PRINTER    PL0T5    ONLY 

C I5PEC=1     PRODUCE     PRINTER    AND    TEKTRONIX    SPECTRA 

C 

I K  T  =  1 

F  EC-PEC  =  IF  EG 
I  COO       CONTINUE 
C 
C 

C REAL"  DAT*     FROM    TAPE     INTO    5     UBRtCS) 

C 

25'.f(       CALL    TAPE  (IBEG.lEND.l  SENS, SI 

I  =  (  1FNL>-  It-EC*]  )  *b^ 


DBLINT   Listing    11     (1    of    4) 
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LEVFL       21  MAIN  DATE    =77225  18/20/34 

3000       CTNT1NUE 
C 

BIAS=0. 

DC     9t     1=1, N 
9b  b  IA5=P  1AS*S  (1  ) 

B1A5=B1A5/N 

WRJTE (6 ,9128)     BIAS 
S126       FCRMAT(1X,"    BIAS    ESTIMATE    FOR     INPUT     DATA«,F10.6J 

Of    99     1  =  1  ,N 
99  SU )=S( I J-6  1AS 

C 
C  USE    HI-PASS    FILTER    FIRST    TL    CUT    OUT    LOW     FREQS 

C LTW    =    0       :       PRODUCES    ICW    PASS    FILTER     (HI    CUT) 

C  =    1        :      PRODUCES    MGF    PASS    FILTER     (LOW    CUT) 

C 

ltw  =  i 

CALl     CLEANCS,N,LDWfFCl,FSJ 

LCW  =  ( 

CALL  CLEAN  (F  S  ,  N  .  LGW  ,  FC  2  ,  F  S  ) 

N2=N/2 

AVGFS=0. 

LT  8  s  8  1=1  ,  M 

IF  (1  .LT  J  -2)     AVCFS=AVCFS-»FS  (I  ) 
oPi  S12t 1 l=SI II 

C 
C 

C ESTIMATE     A    KEAN    FDR    F5 

C 

AVGFS=A  Vl-F5/(N-3) 

WRITE  (fc  ,9129)     AVGFS 
912?       FCR';Tll/,»    MEAN     ESTIMATE     FCh     FILTERED    DATA«,F10.£) 

li  f"    2  9     1=2  ,  K 
29  F5U  )=FS(  D-AVGFS 

C 

C INTEGRATE  «     IF     J  NT     =•    1 

C 

N  T  1 ».  L  S  =  2 

WP  IT  E ( t  ,9  102)     N  T  I  m  fc  5 
91U2       I rK-»  T (  5>,  'INTEGRATING  ,.l^,  »       T  IK ES • I 

IF  (INT. EC. 01     G(     TT     6UCC 

L  L  \4  G  T  H  =•  5 1  2 
"300  ICNTIWUE 

Df    :-•!     I  I  =  LENGThfN  .LENGTH 

Lft5T=0. 

L5TRT=1 I-LENGTH41 

1F(  I  I.EU.LNGTH2)  L STRT =L5TRT *  1 

LSTRT=1 l-LENGTh+2 

Df     3c     L=LSTRT,1I 

S(I J=LA5T+(FS(1)*FS(1-1J 1/2.0 
32  L«ST=S(I) 

r 

V 

C NOW    IF  TREND    DISPLACEMENT 

►,CEC  =  1 

DBLINT  Listing   11    (2   of   4) 
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LEVEL       21  HA1N  DATE    =    77229  18/20/34 

IS  Ml 

NT*N-LEKGT>*1 
C  DE    '<L     I  =1  ,NT, LENGTH 

41  II ntinue 

CHI     DDTMPfSfLSTRT  >  .LENGTH  ,f.  DEC,  I  SF) 
LT     33     1=LSTPT,IJ 
IFUhT+l.tE.NTlKES)     F5  (  I)  =5  (  J  ) 
33    ICNT1NUE 
31  CTNT1NUE 

I  r  T  =  1  M  T  ♦  2 

c 

IF  (  Il.T.Lfc  .NT  IK  t  5  )     GL    TC     SCO 

C FRH  T    RESULTS 

C 

1  F  C  I  SPEC  -ECO)     GU    TL     6000 

IF  (  1  SPEC  .tC.l  )     GL     TC    700C 
C 
fcCLfi       CENTIMJfc 

SUHl-*0  .0 

SUM  2=0*0 

N  *■  =  N  •»  *5 

K  L  R  I  S  T  =  A  !  5  (  S  (  1  )  ) 

IV    W>     1 =2 ,Nfc 

*5=A:-S(5(  I)) 
49S  1 F  {t  5 .07  .RLRGST  )     RLRG5T=AS 

5CL=S./RLRC5T 

*p  1  TE  (b  ,919°)     RLR  GST ,SCL 
C 

C CALCULATE     RUfoM  NC    H.EAf-S 

C 

kMTE  (b  ,< -t  .1  ) 
9601        Ft  k^/TUhl  ,  ■       kAK     AC  C  .  •  ,  T27  ,  'AC  C  E  LE  R  A  T  1  Dl\  • ,  T  5  2  ,  ■    FILTERED     '^77, 
1  •    FILTERED     »/T27, "PUN  .PEAK »,T52. •ACCLERAT1PN»,T77, "RUN. MEAN"/) 

I""-1' 

it     t-*0    I  -1  ,\' 

I  M=1M+1 

S U  K 1 =  5U  M 1  *  F  5 <  I  ) 

su" :  =  su'  c*i  (i  ) 

ft  F  S  =  ' UM 1 /I 

c 5  =M  v  2 /  1  " 

1  P  =  M  1  )  *SQ  +5  . 

1  F  C  I  I  .LT.11  .A'tu.l  P.C-T  .G)     Pl71UP)=S7AR 

1P=-S*SCL  +  5 . 

|F(  I  F.LT.H  .AKL.IP.GT.C)     PL  1  i  (  1  P  )  =S  T*  F 

1F-FSCI  }*5CL*5 . 

IF  (  1P.LT.  1  1  .*M  .1  P.CT  .0  )    PL  73  (IP) -STAR 

IP  =  /I  S*SCL*5. 

IF  (IF.L7.11.AM.1P.CT.U     PLT4C1P )=STAR 
c,ocu        H  R'  /iT  (  IX  ) 

HITH6t96iO)    S  ( I  ) ,  ( PL  T  1  ("  )  ,K  =1  , 1  0  ) ,  A5  ,  (PLT2  (  M)  ,  M  =  1 ,  10  )  ,  F  S(  I J  , 
1  f FLT3(M) a*S] tic)tAFSt 1PLT4  CK).M*1«]0)V J 

9f  a  '         f[^/T(lA,Mf  l':.t,K'Aj  ,SM,T12i,l6) 

L  r  m     j  =  i  tifi 

i  1 7 :  U)  =i  i.'.k 

DBLINT   Listing    11    ( 3    of    4) 
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LEVFL       21  MAIN  DATE     =   77229  18/20/34 

PLT2IJ)'*BINK 
PLT3CJ)=tLNK 

60  PLTMJ)=tlNK 

PLT1(5)=LTRI 
PLT2  (5  I  =LTR I 
PLT3(5)=LTR1 

PLTA(5) =LTR1 

IFCHTDCl  iLENGTh J.Nt.O)  CL  TD  6t0 

«RITE (6  ,99°9) 

5UM2=0. 

919^   FLRMAT  (1U  .2F12.6  ) 

6C0    CCNTINUE 

C 

C CALCULATE  SPECTRA  , 

C 

7OU0       CCNTINUE 

INT  =  J 
C 

CALL    T7RACE(lStNSflPEC,  lTAPE,lFILE,N,S.FStS12,INT) 

CALL    PL  L  T     (CiU.i-3) 

CALL    FACTCR    (1.56J 
C  CALL    FACTTK     U.OO) 

(ALL     SPECT(FS,S,N tl,S12) 
8U0C       CALL     PLL'T  (C.  ,U-,999  ) 
C 

MCP 

LE50C     SUl  CHK  (5,S1?,FS  ) 

END 
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LEVEL 

21                                          TAPE                                   BATE    *   7722*                       IB/29/00 

SUBROUTINE    TAPE < BEGR EC , EAOREC tCHANC ,A ) 
C              SLBRCUTINE    TAPE (B ECREC .EIOREC »CHANC tA »B  ) 

C              REAL    1(1) 

-TX1 S   ROUTINE    READS    DATA    FRO*    TAPE    FROM    CHANNa    CHANO. 
RECORDS    6EGREC    TO    ENDREC    ARC    STORES    IN    A. 

c— ~  - 

-IFF    =    FUNCTION    FLAG: 

1    -    INITIALIZE   CALIBRATICN    TABLE 

£__-» 

2  -   READ    TAPE    AFTER    REWIRD1NG    ICURREC   RESET  «0I 

3  -   READ    TAPE    STARTUC    FROK    BHERE  LAST    CALL    LEFT    OFF 

REAL    All  ).SENS(64.37) 

^UTECER    TAPEN0C2) 
INTEGER    BEGRECaENDREC,CHANO 

KK*C 
IFF=1 

1=0 

CALL    SITKA    (IFF.I . I RF .SEMS.TAPENO .IDATE  1 

1000 

I=BBCREC 
IFF=3 

CALL    SITKA    f I FF •  1  ,1RF  .SENS.TAPENG tlDATE ) 
1FURF.NE.1I    WRITEC6.9600I    IRF.J 

DC    2    K=l,64 
KK*KK-»1 

L 
2 

B(KKJ=SEN5«K,CHAN0*2I 
A(KK)=SENSCK,CHANO} 

IFCI.LE.ENDREC)    GO   TQ    10CO 

WRITE (6  ,9000}    BEGR EC • IRDREC ,CHANC ,KK 

9000 

FORHATC  ■   RECORD   NO.:',!*,"   TCSIS/1    CHANNEL:            ■,13/ 
1          »N0.    OF    POINTS:     SISI 

9BUU 

FlRHATl*    IRF    IS:    *. 14, 1GX, »RECDRD    NO.    I5Btl5> 

RETURN 

"END 

TAPE    Listing    12 
90 


I  "VEL 7V 


CTET1 


DAU    *    7/13T 


IV 735/55 


rLEANT37*iITJl,Ft  .F5) 
REAL    Slll.l.d) 


-ITTAITB  -D7  4TKJ07  ~rkV  ,Hin  7AT7  •  AA3  ,  A  A  4*  ri*5T&Bl  ,BB  1.B6  2,Bl3,feB4  , 
]  BB5,C,AA,A0,A1,A2,*3,£4,A5 ,6  1.82  *B3,B4»65 


COMPUTES    FIVE-POLE    BUTTERWORTH    FILTER 


PARAMETERS 


5 

n — 

LOW 


FC 
TS 


INPUT    SIGKAL    TO   BE    FILTERED 
"HUWBER   Of    POINTS    IN    S 

0    -    FOR    LOW    PASS    FILTER 
^    ^TOR  >1GK1>AS5  FILTER 

CUTOFF    FREQUENC1       (FREQ 
"FILTERED    OUT PUT  SIGNAL 


AT    CAIN    OF    1/CSQRTC2H1 


NCTE:       DIMENSION    OF    S    AND    FS    HIST    EE    N«5. 


^^~7>R0CRAHKER:      D. GREENE,    37A    12/8/16. 


2 

t 


HC  ©ATA    AAC,AAI,AA2,AA3,*A4,AA5/1/,5«C  ./ 

DATA    AAC,AA1,AA2,AA3,AA4,AA5/1.D0,5*0.D0/ 


DATA    BBO,BBI,BB2TBB  3TFB  4  TIB  5/  rTDC  ,2  .2 36068 DO  ,5 .23  €068  DO , 

I  5.236068D0  ,3  .326068  DO  ,1 -DO/ 

~DTTA    BBC,BB1,BB2,BB3,1B4,BB5/1.,3  .236068,5.236068  ,5.236068, 

I         3.236068,1./ 
"DATA  7>l/3  .141 59265  36/ 


DC    1    1=1, N 

K=N-M6 

-ii=n-i«i 

D(K)=S(  111 
~5 1*1=3(11! 


DO    2    1  =  1  iT ~ 

FS(I)=0.0 

-PTII^O.^CO 
SM)=0.0 

IF(LOW.EQ.O)    C=C0TAN«.C7*PI«FC) 

"~ rFmrw  rEB  n  1  c  =r  a  w  i  .in  *ft  *f  c  i 


I*=UB0«BB1«C+BB?*C**24BB3«C*«3<BB4«C**4«BB5*L«*5 
AC=(AA0*AAl»C«AA2«€««2  4AA3*C«*2*AA<l*C*e4«AA5*C**5  1/AA 
-m«T5.^AA0«3.»AA18e4AA2*C*»2-AA3*C**3-3.»«A4*C**4~5.*AA5» 
1         C«*5]/AA 
~ir2=TT0  7^in)*2  ^HAl*C-27*ffA2*I  **2-2 . **I3*C«~3«2  ;*i  I4"»t*«4*n)^ 
1         AA5»C**5I/AA 

A3sntJ.^AA0^2.*AAl*C-2.»IA2»C**2"«2.*AA3*C**3-e2.«AJI4sC»»4-l0.» 
1       AA5«C««5J/AA 

"_A^=T3.^AAT)^.^AAl*C^Sa2*CS*^<IA3eC««3-l.siA4*C**4;»5.*AA5* 
1       C«*51/AA 
"IR^TATTO  -A  Al  *C«  AA2~*F**^H 'AT*T«3  «XA4  *£"**  4-AA5*t  **¥im 

CLEAN  Listing   13    {1   of    2) 


TVET       21 


CLEAR 


DATE    *   77131 


19/35/55 


Bl  = 

B 

B3  = 


(5.* 
(10^. 
B5«C 
(10. 


68043.*BBl«C+B62«C«*2-BB3«C««3-3.sBB4«C««4-5.ftBB5*C**5)/AA 

«B  B  0   *2.»BBl«e-2  .«BB2*C»«2-2  .«BB3«C««3«2  .«BB4«C**<t*10.« 

««5)/AA 

*BBQ-2.»BBl»C-2  «,»IB2«f«2«2c»§B3»C««3«2a*BB4»C»*4-10.g 


C**5)/AA 

BB0-3.l»BBl«C  +  Be2'>Cg«2«BB3«C<«3-3.«BB4«C»«*45»*BB5«C»«5>/AA 

^B¥I«C"»BB2«C««2-TB3«t««3-»BB**C««A-BB5«C«»5  1/AA 

EG -0  I    GO    TO    50CC 


1 


B4  = 
~BT« 

IF( 
Hl  = 

A5  = 

Bl  = 

~63  = 

B5  = 


BB5* 

(5.* 

TBBO 

LOW. 

-Al 

-A3 

-*5 

-Bl 

-B3 

-6  5 


C 

c 


NOW    FILTER    S 


"C" 
5000 


DC    100     !=1»N 

_FTTI-»5}=A0*D(  !«5)«A1«C  tr«M*A2«fr(1T5r*A3'^CI«2V«A4*D(I«l)« 
1         A5«D(1  )-Bl*FSCI*4l-B2«FMM3l-B2*FSJM2>-B4*FS  CI*1)-B5»FS<  II 
~TSI]«5)sA0«SU*5)«Al*S(]«4)«A?«S(  1«31*A3«5  1 1-*2  )'«i4«$Jl*-l  K' 
1         <5g5(17-Bl»FSt I+4t-B2«FS(l«3l-B3»FS(I+2>-B*»F3  ll«l } -B5»FSt  II 

CONTINUE 


¥R IT E( fe.95001    AO,  Al  ,A2  ,S3  ,A4  ,A5  ,B  1  ,B2  ,B3rB4  7B5 
FCRMATdhl,  •FOLLOWING.   ARE    A    ARC    B    COEFFICIENTS 

"RETURN 

DEBUG  SUBTRACE      

~EKD 


•>6F15.6/5Fl5-fc) 
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T-KVkL 

21                                        DDTRID                            DATE   -  77131 

19/&S755 

SUBROUTINE    DDTRND  (V ,N  ,  NDE£ , ISF J 

REAL«8    X<520     » , SO , SUN , 5UBP . SI , 52, TflEAN.XN eAVEI 9SLCPE 

REAL    T(l) 

1F(N.LE.3076)    CO    TO    1000 

9800 

WR1TE(6,9800)    N 

FCRHATl*    CANNOT   DETREIC.    RED1NENSICN    I  IN  1   TO  S    %!58 

1000 

"RETURN 
OC    100    1  =  1.  N 

100 

X(1)=Y(I1«1.0DO 

1FI  ISF.GE.DCO    TO    24 

SC=O.ODC 
SUM=O.ODO 

SUHH=O.0DO 
51=0. ODC 

c 

S2=O.OD0 

c 

c 

-IF    NDEG=1    REMOVE    BOTH   HEAN   AMD   LINEAR    TRAmD 

IFINDEG.GT.01    GO    TU    2C 
00    6    1=1, N 

8 

SUH=5UM«X(I) 

CONTINUE 



THEAK=SUM/XN 
~5UN=0.T)D0 

DC    10    1=1, N 
"in)=H(I)-lWEAN 

SUM=5UM+X(1  ) 

10 

SUHH=SUHH-»X(I  1  »X  1 1  ) 

CONTINUE 
-RETURN 

c 

C REHOVF.   HE  AN  UNO    LINEAR  TRFNO 

C 

2D DTJ -22  "I  =1  ."N 

S1  =  S1*X  f  I J 

22  S2=S2*51 
AVEI=(N+U«0.5D0 
XN=N 
TKEAN=S1/XN 

SV0rE  =  =T2.TrD0»tS2-AVEI1'Srr7Tl^rN«N-nT 

24     CONTINUE 

OC  28  1=1,1! 

23  X(l)=Xin-THEAN-SLOPE«(l-AVEII 
28    ^ttt)=*tl) 

MRITE(6, 99991  SLOPE 

-9^9  -F-eRNATt^-snrorE  -rs-»iT-xt)  .^n— 

RETURN 
— EKD 
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LEVEL   ?1  TTRACE  DATE  *  77226  17/09/56 

SUPkOUTINE  TTRAC  E (  ISf NS.  IBEC , if  A  PE~,1  FILE  ,N  ,Ds7vTTs  .INtI 
DIMENSION  DS<1), VS(1),S(1 ),M 32 CO) 

INTEGER  PPR 

THIS    PROCRAM    PLOTS    THREE    CALCOPP    PLOTS    FOR    UP    TC    «8   RECORDS 

—  --INITIAL  I  2E  ™ 

CALL     FACTDR(.25) 
C 

TAPE  =1  TAPE 

RECMBEC 

FILE  =1  FILE 
SEN  5=1  SENS 
INC  =  1 
VAX15=2 . 
L  INTYP^L 

1NTE&=0  

PPR=64 
XLPC  =C. 

yloc=c . 

XlNC  =1./PPR 

51NC=1  ./A. 46 

KSFl=.C7*N 

FXLrC=XLDC*.5 

Wk  IT Fl 6, 9000  )     I  TAPE,  IF  HE,  I  SENS,  IE  EC 
5000       FCkMAT  (lhl.  •    TAPE    NO  .  ■ ,  15  .  ■-  ■ ,  1  2/  ■    SENSOR'. I3/»    B  ECREC  ,  15// 1 

WR  1  T  L(6  ,911 1  1     TAPE. F  HE  .SENS, REC 
9111        FOR-AT (1X,T8,4(F6 .0, 5X  ) ) 
C 

T 5FT    ORIGIN 

C 

CALL    PL0T(XLDC,YL0C-H  .,-3) 
C 

C PLCT    TAPE     INFORMATION 

C 


FYLLC=2. 

CALL  PlUT(FXLGC,FYL0C,3l 
10     CCNTINUE 
f. 

t PLOT  SECOND  MARKS 

(. 

DO  100  1  =1  ,NSEC 

T1CK=SINC*1 
ICu         C*_LL_  SYMBOL  (FXL0C«T1C*  .FTLOC  « -C7 .13  »0.»-l) 

TTRACE    Listing    15    (1    of    3) 
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G "LEVEL       21  TTRACE  DATE    «    7722  6  17/09/56 


1111 


9010 


SG2  0 


FYLDC=FYLOC*(VAXIS  )*  ,5 

C 

C CCNSTRUCT    X-AXIS    ARRAY 

C 

CO    200     1=1  ,N 


200  X ( I ) =1 *X INC 

XfN-U  )=0. 
X(N  +  2  )=1  . 
XEND=X(N) 
C 

C FIND     SCALING    FACTORS  

C 

5MAX=ABS(DS( 1 ) ) 
U2=h-2 

OC    3(0     1=2,N2 
TEMP=ABS<LS(  1)  ) 
_  IF(TEHP.GT.SHAX)     SMAX=TEKP 

300         CONTINUE 

CELTAV=SMAX/2. 
F1R5TV=C. 

KR1TE(6,9100)    DEL TA V  ,F I R ST V 
9100       FCRHATdX,  »DELTAV  »,FlC.3/»    F  1RST  V  •  ,  F  10.  3//  J 
C  _ 

CS(KU  )=FIRSTV 

V5(N*1)=FIRSTV 

5(N  +  1  )  =  F1RSTV 

CS  (N*2  )=DtLT  AV 

VSCM2  )  =DELTAV 

S(K*2  )=DELTAV 

C 

C PLOT    DATA 

C 

1CO0  IFC1NT.LT. 3)    GO    TO    2CC0 

DC    1111     1=1,N 
X(I  )=X(1  MFXLOC 


X  i  i  l  =  x  (  l  j-»rxLUt. 

D5( 1 )=DS(1J*FYLUC»DELTAV 

CALL    LINE  (X,  DS.N,  INC,  L  I*T  YP  ,  IK Tfc  C  1 

CALL     SYKBr:L(XEND*.5fFYLCCt  .35, 12HC ISPL ACEKENT t0 . ,12 ) 

WRITE  (6,9010  ) 
FCRHATdX,  •DISPLACEMENT    FASbEFK    PLOTTED*! 

CO    TO    4000 


C 

20C0       1FCINT.LT.2)    GO    TO    30CC 

Ur    2i22     1=1,N 
222? 


UT    2i22     I =1  ,N 

V5(  I  )=VS(  I  )-»FYLDC«DELTAV 

CALL    L1NEU,VS,N,INC,L!KTYP,IKTEG) 

CALL     SYMBLL(XEND-».5,FYLCC,  .3  5,8F  VE  LOC  I  T  Y  ,0  .  ,  8  ) 

WR  ITE(6,9020) 
FCRMAT  (I/,  'VELOCITY    h*S    EEEN    PLCTTEO*/) 

gc   tc   a  con 


( 

ifiuO        IF  (  INT. LI  .1  )    GD    T  P.    4CCC 

DC     3333     1=1 tN 
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LEVEL   2)  TTRACE  DATE  «  1122%  17/09/56 

3  33  3" 


9030 
C 


5(1 )=5(I )*FYLOC*DELTAV 
CALL     LINE  (XjS.N,  1  N  C  ,L  1NTYP  ,  INT  EG) 
CALL     SYHb0L(XEND*.5,FYLCC,.35,I2HAlLtLERATI 

WR  ITE(6.9030) 
FCRMATdX,  •ACCELERATICM    MS    E  EEN    PLOTTED*//) 

DRAW     RFFFRFNfF     I   1  U  F      Akin     WPCTITfl       A  *  I  c 


CCELERATI0N.0..12) 


C DRAW    REFERENCE    LINE    AND    VERTICAL    AXIS 

C 

4000       CALL    PL0T(XEND.FYL0Ci3) 

CALL     PLUT(FXLCC,FYLQC,2) 

CALL    NUHBER{XL0C,FYLCC*1.,.28.DELTAV.C.,2) 
CALL    PLCT  (FXLOCjFYLrC-*!  .j,3) 

CALL     PL0T(FXL0C,FYL0C-1 .,2 ) 

C  ALL    NUMBER<XL0C,FYLCC-1.,.2  8,-DELTAV,0.,2) 

FYLUC=FYLDC*VAXlS-»2. 

INT  =  IKT-1 

IF  (INT  -GT.O)    CO    TO     1CCC 
C__ 

C PLOT    RECORD    REFERENCE    HAPKS 

C 

5000       CFNTINUE 

FYL0C=FYLCC-2 

CALL     PLCT(FXLCC,FYL0C,3 J 
__  REC  =  REC-1 . 

ro  *oo   i =i  ,n  ,ppr    • 

TICK  =X1 NC *I 

PEC=REC-»). 

CALL  SYMpOL  (FXLUC+T  I  C  *  ,  FY  L  CC  ,  .2  6  , 1  2 ,0.,-lJ 
500    CALL  NUKfcERCFXLOC*TICK4XINC,FVL0Ct.26,REC,0.,-l) 
C 

C       CALL  PLCT(0.,U.,999 ) 
END 
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LEVEL 

21                                          SPECT                                ©ATE    •   77224                       SB/29/00 

C 

SLBRCUTINE   SPECT IV5.DS ,» elBtt ,*S J 

C 

C 

-THIS   ROUTINE   CALLS    IHTPWA    TO   CCKPUTE    THE    SPECTRA   Cf 
ARRAYS    OS   AND    VS9    DIMENSIONED    CO    N,    BEGINNING    BIYF    POINT 

C 
C 

1BEG.       IT    PLOTS    SPECTRA    IN    8   RECORG    CROUPS. 

COMhCN/EXPARH/ITAPE.BECREC,llSUKeAMPMAX,VSCAL»T  ITL  1 
COMMON/  1NPARM/CCSIZE.CTV1SEN5VTMEAA,VAR  I 

C 

DIMENSION    VS ( 1 ), DS C 1 !,N 1 t 516) »k2( 516 ),K3( 516! .ASCII 

C 

DIMENSION  V5I11  ,DS  (1)  aUl  (516 )  »ht2(  516 )  ,|BUF(2000  I  *fe3  (5  16 ) .AS  11 ) 

INTEGER    TTLC8) 

INTEGER    TITLEU1 
IATEGER    BEGREC 

C 

DATA    TTL/«      AC8,8CEL     % »SPEC  •, 8TRUF ■  ,  •           •."WEL    8.«      DI^SPL    ■/ 

DT=.071 
CCSIZE*1.3 

AKPMAX=.C01 

NSUK=0 

C 

MTEST'O 

KLOC=l. 
TLOC*l. 

«P=512 

1PR=0 

C 

lENDsIBEG+KP 

IP 

DC    l^TMEND.N.NP 
ISTRTM'-NP+l 

JJ  =  1     =^ 
1PR=IPR*1 

9990 

IFI1PR.GT.6)    GO    TO    90C 
CONTINUE             , 

DC    2    J^ISTRT^JC^37 

sHJJJ=V5(JJ 

H2UJMDSU? 
M3(JJ)-AS(J) 

2 
C 

JJ-JJ*1 

9991 

CCNTINUE 

PRINT    375,IEND,NP,1STAT 

375 

FCRMATUXs  8VEL/DlSP89I<i9.8REACY    FOR    INTPHA    FOR9, IS,8    START    AT     *, 
3         -PT",!?) 

C 

BEGREC =BEGREC«8 

APT>MAX  =  .002 
VSCAL*»050 

500 

DO    500    8=lt4 
TITLE(1)«TTL(IJ 



C*LL    !MTPVA(XL0C,fL0C.lSENSvh3«NP  ) 
CALL    Pt0Tf8.5»0-t-3! 

AMPMAX=.010 
VSCAL=.100 

SPECT   Listing    16    (1    of    2) 
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LEVEL 

21                                          SPEC! 

SATE 

*   7722* 

lt/29/00 

600 

DD   600    1=1,2 
T!TLECI)*TTLCI*6) 

CALL    INTPKA  CXLOC,  VLOC.ISEIS  »bl.RP  I 
CALL    PL0TC8.5,G.,-3) 

ARPHAX-.OAO 
V5CAL*.20 

700 

M    100    1*1,2 
TITLE  (I  1*TTL(I*6) 

CALL    HtTPVACXL0C,YL0CaISEftS,k2,NP) 
CALL    PL0U-17.,-5.,-3l 

1 
C 

CCNTINUE 

900 
C   900 
90 

CONTINUE 

CALL    PLOTCO.,0.,999] 

STOP 
EKO 

SPECT   Listing    16    (2   of    2) 
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SUBROUTINE  DTRND2 

INTRODUCTION 

This  routine  removes  either  the  mean  or  mean  and  linear 
trend  from  an  input  time  series.  The  mean  and  variance  values 
for  the  input  series  are  also  returned. 

The  primary  use  of  DTRND2  is  to  remove  the  mean  and  linear 
trend  before  the  fourier  transform  is  performed  in  programs 
ACCSPC  or  WNDSPC.   The  standard  method  is  to  call  DTRND2  then 
window  the  data  to  taper  the  ends,  readjust  amplitudes,  then  call 
DTRND2  again  to  remove  any  slight  mean  or  trend  in  the  data  after 
windowing. 

See  Figure  31,  Table  9  and  Listing  17. 


OPERATIONAL  NOTES 

This  routine  removes  either  the  mean  or  mean  and  linear 
trend  from  an  input  time  series.   The  mean  and  variance  values 
for  the  input  series  are  also  returned. 
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I    ENTRY    J 


INITIALIZE 
ACCUMULATORS 


PRINT 

MEAN  & 

VARIANCE 


(       RETURN     J 


NO 

/  NDEG  >v 
<T    .GT.    ^> 
^,0.9  yS 

YES 

\ 

' 

v 

CALCULATE 
MEAN 

CALCULATE 

MEAN  & 

TREND 

> 

t 

V 

REMOVE  MEAN 

& 

ACCUMULATE 

SUMS 

REMOVE  MEAN 

&  TREND 
ACCUM.  SUMS 

> 

t 

»» 

\ 

/ 

CALCULATE 
VARIANCE 

\ 

(  .._ 

Figure  31.   Subroutine  DTRND2  Flow  Chart 
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Table  9.   DTRND2  Variable  Name  List 


Name 


Com 


Type 


AVE  I 

I 

N 

NDEG 

SI 

S2 

SD 

SLOPE 

SUM 

SUMM 

TMEAN 

VARI 

X 


R 

I 
I 
I 
R 
R 
R 
R 
R 
R 
R 
R 
R 


Dimension 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
Passed 


Usage 


N/2   +    h 

General  Index 

Number  of  points  to  detrend 

Degree  of  polynomial  to  remove 

Sum  of  data  values 

Another  sum 

Standard  deviation 

Trend  of  the  data 

Sum  of  all  data  values 

Sum  of  data  values  equared 

Mean  value  of  X 

Variance  of  X 

Data  array 
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IV    G    LEVEL       21  DTRND2  DATE    «    76275  18/25/22 

SUBR0UT1M    DTRND2     (  X  ,N  ,NDEG  ,TME  AN  ,\  AR1  J 
UHENSION    X(l) 

SD=O.D 
5U*=0.C 
SUKM=0.0 
51=0. 
S2=0. 
C  IF     NDEG=1       REMDVE    BOTH    MEAN    AND    L1NEIR    TREND 

IF     (NDEG.&T.OJ  GO     TO    20 

co  e  1*1, u 
sj^ =5 i n  +x  (i  ) 

6  CONTINUE 

TMEAN=SUM/M 

SUK=0.0 

DJ     10    I =  1,  M 

XU  )=X(  I  )-TME  AN 

SUM=5U^+X(  I  ) 

SfJ1M=SJMH»XCI  1»X(II 
10  C3UIMJE 

GO    TO    100 
C  REMOVE     MEAN    AND    LIKEAR    TREND 

2  0     DC    2  2     1  -  1  ,  N 

S1=S1M  (I) 
12     S2=S2*S1 

AVE  I=0.5»(N*1  .0  ) 

TMEAN=S1/S 

5L3PE=-12.M>2-MEI*S1)MN*(N*N-1.0M 

DC    26    1=1,N 

X(  I  )=Xt  I )-TMEAN-SLOPE*t!-AVEl ) 

SUHsr5JM4X(l    ) 

28    $J1H=SJMM»< (I }»(II) 
C 
C  COHP'JTE    S.D.    AND    VARl 

100     TEMP=S  JKM/N-C  SUM/N)  *(SUM  /H) 
VM I =r  E  M  P 

IFtTEIP.GT.O.O)       5D=S0RT  CTEMP) 
C  VFL=TMEAN*.4«i7 

PRINT    160,7MEAN, VAR 1 
ISO    F3**AT     (  »0r  *EM  =  ' ,F  10.b,»         VARI*  »  ,Fi ) .&) 
RETURN 
END 


DTRND2    Listing    17 
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ROUTINE  INTRPN  OPERATIONAL  NOTES 

This  routine  used  four  points  from  each  end  of  a  data 
record  to  interpolate  NUMI  missing  points  between  using  Newton's 
divided  difference  form. 

In  the  case  of  old  wind  data  to  be  decimated  to  .28 
seconds  sampling  interval  for  anlysis  use,  NUMI=1  missing  point 
needed  to  be  supplied. 
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Table  10.   INTRPN  Variable  Name  List 


Name 


Com 


DATA 

I 

12 

IK 

IKK 

ISF 

J 

K 

K2 

KK 

LI 

L2 

M 

N 

NI 
N2 
NK 

NN 
NP 

NUM1 
POLY 


Type  Dimension 


R 

I 
R 
I 
I 

I 
I 
I 
I 
I 
I 
I 
I 
I 

I 
R 
I 

I 
I 
I 
R 


Passed 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
1 
1 

1 
1 
1 
40 


Usage 


Input  Array 

General  Index 

General  Index 

General  Index 

General  Index 

Initialization  Flag 

General  Index 

General  Index 

General  Index 

General  Index 

Normalization  Factor 

Normalization  Factor 

General  Index 

Number  of  Points  Used  From  Each 
Record 

HUM2-N 

NUM1+1 

Number  of  Original  Data  Points/ 
Record 

N+l 

NK-3 

Number  of  Points  to  Interpolate 

Polynomial 
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..UMii  ii.c     iiH«r«  d\LKl  ,C#Ut>K,I5F  1     3^r 

SLDKCUT1NE     INTERP  (N.Nm  ,CAT*  vfcKt!!F) 

*        i  ir-:'     't       1 

variables 

n:  number  cf  points  to  be  usee  from  e  *ch  record 

nuk]:        number  cf  fcims  tc  be   interpolate! 
data:         input  array,  nk  pc  ims   input  ,kk  ♦  nup  1  output 
kust  be  cimensihnec   cnmnimh*) 

lies  nekums  c1viced  cipference  fcrm  fcr  equally  spaced 

punt   interpolation;  fincs  pclyncmial  of  decree  k-i 
(for  n  =  mm2-numl)   and   interpolates  points  between 
pcly(ft/2)   and  poly(n/2*i)  at   intervals  of  1/cnuh1*1j. 

lccal  variables 

REAL  DATA (1 ),PuLY(40)  ,12, N2 
INTEGER  KUH1|NUM2|I »K  ,K2  ,L 1  ,L 2,M, N 

INITIALIZE  PROGRAM 

N  =  4 

M=N*2-1 

LI  =  1 

N  F  =  U  K  -  M  -t  1 

-PfND  =  2*«\-»NliNl 
C 

C STORE   LAST  POINTS  IN  BEGINNING  CF  PL'LY 

C 

IF  (1SF  .EG.C)    CD  TO  eCCC 
C      RECALL  STORED  POINTS  CF  FPEVIOLS  RECORC 
C 

DC  1  I  =  1  ,  N 

KsflM  M!f'l-»  I 

1  P  C  L  Y  ( I  )  =  D  A  T  A  ( K  ) 

C      "PLT  BEGINNING  POINTS  IN  FCLY 

DC  s2  I=1,N 

K  =  N+I 
42  PCLY(K  )=DATM I  ) 
1COC   CCNT1NUC 

DL  M   I=},.'JK 

I  *  =  N  K  -  I  ■•  1 

IKK=NK-  MNUMl  +  1 
4C  DATA{ IKK)=DATA(1K  ) 

C 

C CALCLLATE     POLYNOMIAL     CCEFFICENTS 

C 

1C  K=N*2 

DC    2    1  =  1  ,M 

K=K-1 

L2  =-«L  1 

PCLY(K«J)=(POLY(K)-FOtY(Ml))/L2 

2  CONTINUE 
IFC..EQ.]  I    CO    Til    2C 
NsM-1 


INTRPN  Listing   18    (1  of   2) 
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Gt  7C  1C 
C 

C CALCULATE  INTERPOLATING  FCIMS  FRO*  POLY 

C 

2C     M=NUH2-N 

K  ^  =  h  <  1 

I  2  =N 

N2=NUM1«1 

c 

DC  3  J  =  1,MK1 
I2=I2*(I/N2) 

DATA  (J) =PCIY(N*2) 

K2=M 

C  C  4  I  =  2  ,  P 

DATA!  J)=CATACJ1*C12-K2)-»FCLYCK2  J 

K2=K- I 
4      CONTINUE 
2      CONTINUE 

C       STOKE  LAST  POINTS  IN  EKC  CF  CATA  ARRAY 

6000  DC  31  I =1  ,N 

K=NP+HUM1*I-1 

KK  =K-»N 
30    DMA  (KK  J=DATA(K) 
RETLRK 
tND 
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PROGRAM  MODE 3D 


INTRODUCTION 

This  program  produces  a  small  three  dimensional  view  of 
the  bridge  at  each  recorded  time  increment.   Each  record 
requested  in  the  main  program  uses  one  call  to  subroutine 
M0DE3D  which  outputs  64  of  the  3D  bridge  plots  (16  down  by  4 
across)  through  the  Calcomp  plotter.   A  printout  of  data  values 
is  also  output. 

Using  the  Calcomp  plotter  to  output  the  plots  sets  a 
practical  limit  of  about  four  records  per  request.   However,  a 
test  movie  was  created  from  a  slightly  modified  deck  in  which 
more  records  were  output  continuously  onto  a  filmed  CRT  screen. 

See  Figures  32  through  38,  Table  11  and  Listing  19. 


OPERATIONAL  NOTES 

To  keep  a  constant  scaling  from  record  to  record  a  value 
of  ASCALE  is  input  for  each  run.   A  value  of  .0  30  will  handle 
most  events. 
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Figure  32.   Program  MODE3D  Setup 
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Figure  33.   MODE3D  Driver  Flow  Chart 
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Figure  34.   MODE  3D  Subroutine  Flow  Chart 
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Figure  38.   Example  M0DE3D  Program  Display 
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Table  11.   M0DE3D  Variable  Name  List 


Name 

Com 

Type 

Dimension 

Usage 

ACCMAX 

R 

10 

Max  acceleration  for  ea  deck  channel 

ACCMIN 

R 

10 

Min  Acceleration  for  ea  deck  channel 

ALLMAX 

R 

1 

Overall  maximum  data  value 

ALLMIN 

R 

1 

Overall  minimum  data  value 

AMAX 

R 

1 

Temporary  accelaration  maxima 

AMIN 

R 

1 

Temporary  acceleration  minima 

ASCALE 

R 

1 

Scale  factor 

CENTER 

R 

1 

Firstv/deltav 

DATE 

R 

1 

Date 

DELTAV 

R 

1 

Increment 

FIRS TV 

R 

1 

First  value 

FMEAN 

R 

1 

Mean  value 

I 

I 

1 

General  index 

IBUF 

I 

2000 

Plot  buffer  storage 

ID 

I 

1 

General  index 

I  DATE 

I 

1 

Date  (yr,  jul  date) 

IFF 

I 

1 

Function  flag 

IFRM 

I 

1 

Current  frame  being  processed 

IRF 

I 

1 

Read  status  flag 

ISIDE 

I 

1 

Side  of  bridge 

I  TAPE 

I 

1 

Tape  number  (integer) 

J 

I 

1 

General  index 

JJ 

I 

1 

General  index 

K 

I 

1 

General  index 

NN 

I 

1 

General  index 

NP 

I 

1 

Number  of  points  per  record 

NREC 

I 

1 

Number  of  records 

P 

R 

80,  13 

Array  of  acceleration  data 

REC 

R 

1 

Record  number 

RECNO 

I 

1 

Record  number 

SENS 

R 

64,  37 

1  raw  data  record 
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Table  11.   M0DE3D  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


SKALE 

TAPE 

TAPENO 

TOTAL 

X 

XCFR 

XL 

XLOC 

y 

YCFR 
YLOC 
KAC 


I 
R 

I 
R 
R 
R 
R 
R 
R 
R 
R 
R 


1 

1 

2 

1 

11 

1 

1 

1 

11 

1 

1 

1 


Scaling  factor 

Tape  number 

Tape  number  literal 

Sum  of  accelerations  on  1  channel 

X  coordinate  of  bridge  data  points 

X  location  of  current  bridge  frame 

X  location  of  a  sensor  in  a  frame 

X  coordinate  for  plotter 

Y  coordinate  of  bridge  data  points 

Y  location  of  current  bridge  frame 

Y  coordinate  for  plotter 
Kth  accelerometer 
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LEVEL   21 MAIN DATE  -  77166 10/23/09 

PROGRAM  H3D  ' 

THIS    DRIVER    PROGRAM    PLCT5    A    SCALED   3D    VIFW    OF    THE   .SITKA   BRIDGE 

AT    EACH    RECORDED    TIME    INCREMENT. 

EAC  H__R  E  C  OR  D  JO  ^P  L  0  T__US  E S    J  JL  A  L  L    T  0  JiU  D  E3D    WHICH    PUTPU  TS    fe<t    DP    THE 


3C    BRIDGE    PLOTS    (16    DCWN    BY    <t    ACROSS). 
ROUTINES    CALLED:    SITKA,    P0DE3D 

PROG.    BY    RAY    Z.    SOTCUDEH         S.T.A.  11/2/73 

KCDIFIEC    BY    DUANE    KELSON S.T.A. 1977 


DIMENSION    SENS(6A,37) 
DIMENSION    1BUF(2000) 
INTEGER    TAPEN0(2) ,REC*0 
CALL    PL0TS(IBUF,2000,C  ) 
CALL    NEWPEN(l) 


CALL    FACTOR    1.50) 
CALL    PLOT(0. 0,0.0,-3) 

IFF  =  1 
C 

C  READ    TAPE    NUMBER    CARD     (TC    1NIT    SENSOR    TABLE)    THEN    REQUEST    CARD 

C 


CALL    SITKA(IFFfRECNC,lRF,5ENS,TAPENC,lDATE) 
REAT    25, 1TAPE, REGNO, NREC.ASCALE 
25    FORMAT     (315, F5. 3) 
C 

C      PLDT  TITLE  INFORMATION 

C 


TAPE=ITAPE 

REC=RECNL 

DATE=IDATE 

CALL  SYMtOL  ( 0 .0 , 39 .0  ,  .21  ,5HT AP E *  ,0 .  ,5 > 

CALL  NUMfcER(999.,999.,e21,TAPEi09B-l ) 

CALL  SYMBOL  1999«  ,999^_p  =_21 , AFREC^C  „<i) 

CALL  NUMEER(999.,999.B.219REC ,C.»-1  ) 
CALL  SYMbOL  (999.  ,999  .  ,  .21 , 5H0ATE  =  ,0 . ,5 ) 
CALL  NUMbER(999.,999.,.21,DAlE,0.,-l ) 

1FF=3 
DO    100     1=1,NREC 

CALL    SITKAdFF.RECND,  1 RF  ,SENS ,T APENC , 1DAT E ) 

XLOC=0. 

TLOOO.. 

PRINT    9  5.RECN0 
95    FORMAT-  -C»1RAW    DATA    FOR    RECND=  •  , 14  ,// ) 
CALL__M0DE3D    {  XLOC  ,YL  OC  t  SENSgASCALE  ) 

CALL    PLDT     (10. 0,0. ,-3) 
00    CONTINUE 


100 


VHLl       riUI lUiU|U«Uf77?f 

STUP 

_END '_ 
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LEVEL       21  WAIN DATE    *   77166 10/23/09 

C  SUBROUTINE       M    U    D    E    3    C 


SUBROUTINE    M0DE3D     ( XLOC  ,  YLDC .SENS , A SC AL E } 

THIS    RUUTINE    PLOTS    THE    MCDfc    CF    THE    SITKA    BRIDGE     IN    3-0    VIEWS, 
E*CH    CALL    PRODUCES    6*.    BRIDGE    FRAMES     (16    DOWN    BY    4    ACR0SS1. 


ROUTINES    CALLFD:    HONE 

PARAMETERS: 

XLOC.YLOC-    STARTING    LOCATION    FOR    THE    PLOT    ON    PAPER 

SENS-    ARRAY    CONTAIMNC  1    FULL_RECORD    OF    RAW    ACCEL    DATA. 

A5CALE-    MANUAL    SCALING  FACTOR     (USUALLY    SET=.03t) 

PROG.    BY    RAY    Z.    SOTOUCEH  S.T.A.          11/2/73 

MODIFIED    BY    DUANE    NELSON  S.T.A.         1977 


SUBROUTINE    M0DL3D     (XL CC , UUC .SENS .ASCAL EI 
DIMENSION    P(80,13)(ACCHAXI10) ffACCHlN(10) 
DIMENSION    SENS(64,371 
DIMENSION    XClll.YCll) 
NP  =  64 

DC    3C     J  =  1,1 3 

DC     15     1=1,64 
JJ=J*2 
15    P(l ,J)=SENS(1 ,JJ1 
TCTAL=0  .0 
DC    2C     1 =1  ,NP 

TOTAL=TOTAL*P( I  ,J)  

20      "'"CONTINUE 
C 

C  COMPUTE    MEAN    AND    SUBTRACT    IT    FROM    EACH    PT  . 

C 

FMEAN=TOTAL/N'P 

DC    25    1  =  1, NP  

PT1  ,TJ  =T>  I 1 ,  Jl  -TWEAK 
IFU.NE  .12)       GO    TO    25 

PRINT    2000,  I,  I  PCI  ff  JJ  I.  J  JL-1  ,10  J  ,Pi  1,12) 
2000    FCR*AT(lX,R,4X,ll(lX,F9.5n 
25         CONTINUE 
3C  CONTINUE 

C 

C  FIND    ACC.    MAX    t    MIN    AND    ALSO    OVERALL    MAX    C    BIN 

C 


ALLKAX  =  PH  ,1) 
ALLK1N=P(1,1) 
XL=1.0     . 
or    AD    J=l,10 
A".AX  =  Pt  I  ,J) 
AM1N=P(1,J) 
DC    35    1=1, NP 

1F(P(I , JI.GT.AKAX I       AMAX=P(I,J) 
1F(P(  J, J) .LT.AMIN)        AMIN-P(I.J) 
35  CONTINUE 

M0DE3D   Listing    19    (2   of    5) 
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LEVFL   21  ?.rDE3.D.      DATE  ^  lllbi  10/23/09 

ACCMAX(J)=AMAX 

ACO  IN(J)=AM1N 

1FUMX.GT.ALLMAX  )       ALLMAX=AMX 

IF(AH  IN  .LT.ALLMIN J       ALLM1K=AMIN 
_/J  =  J 

~XL=XL*1  .5 
i»U  CONTINUE 

PRIM    2  5G0.fACCMAX(JJ)vJJ-l,10)t  (ACCMNCLL)  ,IL =1 ,  10  J , ALLNAX „ALL WIN 
25C0    FCRH./T(lh0,7HACC    MAX  ,  2  X  ,  10F  10  -5  .  /  ,1  HO  .7HACC    M  IN  ,2X  »  10F 10  .5  ,  //  , 
HHO.lAHOVFRALl    WAX.=       , F  10  .5  ,10X  ,  UHUVERAlL    MN.=       „F10.5» 

IF  (AUMAX.EQ.ALLM1N)       GO    TO    99  

IFCAESCALLKAXl.CT.ABSfALLHIN))    ""ALL  M  IN=-a;0*ALLMA  > 

IFIAt  S(ALLMAX)  .LT  .AESULLM1N  J)       A LLM AX  =  -1 .G»ALLM 1  ft 

5ET  SCALING  FACTORS 

MANUALLY  SET  SCALING  CCNSTANT  OVER  ALL  RECORDS 
ALLMlN=-.06   ON  OLD  RUNS  OF  SMALL  ROADBED  EVENTS 


ALLM1N=-A5CALE 

ALLMAX=-ALLMIN 

F  IRSTV=ALLM!N 

DELTAV=  JALLMAX-ALLMlN J/1.2 

CENTER=-F1RSTV/DELTAV 


DC    70     1=1,4 
DC    60    J =1,1 6 
IFRM=(1-1)*16*J 

DO    42    K=l,13 
_P<(  I-l)*16*JtK)*( P{ (  1-1  I «16*J,K)-F1R5TV  )•(-!. O/DELTAV)    ^CENTER 

"1FU.E0.12)       PRINT    20C  C  ,  J  ,  (P  1 1  F  RM  ,K  L  1  ,KL  =  1  .  10  1  ,PUFRM  .12  ) 
42         CONTINUE 
C 

C                    RESET    ORIGIN    FOR    THIS    FRAME     CTL    LOUFR    LEFT    CORNER    OF    BRIDGE) 
C 
XCFR=0.  

IT  ~(J. TCI. AND. 17GE. 27      ~1CCFR=7.G 

YCFk=-2.5 

IF     (J.EQ.1.AND.1.GE.2!         YCFR=37.5 

CALL    PLOT     <XCFk,YCFR,-3) 
C 

C      PLOT  THREE  DIMENSIONAL  FRAME  OF  BRIDGE 
C 

CALL  PL0T(XL0C,YL0C,3) 

CALL  PL0T(XL0C*6.0»YLCC,2) 

CALL  PL0T(XL0C+6.5,YLrC*l.U,2 ) 

CALL  PL0T(XLOC-».5,YLOC*l  .092  J 

CALL  PLOT CXL0C,YLDC,2) 

CALL  PL0T(XL0C+1.5,YLrC,3l 

CALL  PL0TCXL0C  +  2.0,YLEC*1  .0,2 ) 

CALL  PLOT  (XL0C  +  5.0.YLEC*1  .0  e3 J 

CALL  PLD7ULDC*4.5,YL0C,2) 

CALL    PL0T(XLDC,YLOC,3J 
C 
C  ENTER    F1RSTV    AND    DELTAV     (ASSUME    LATA    ALREADY    SCALED    FOR    PLOTS 
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L E V E L   2 1  K  C D E  3 D DAT_E  «  77166 10/23/09 

C  

X  (101=0.0 

Y(1D=0.C  

X  ( 1  1  } =1  .c 
__Y  (11  1=1.1; 

DT  5l  IS1DE=1,2 

c 

C        PLACE  DECK  ANCHOR  POINT  LOCATI0N5  INTO  ARRAY 
C 
X(1)=XLDC-.5*(1SIDE*.5) 

Y(I1=YL01*ISIDE-1 

X(31=XL0C-»1.0+(1SIDE*.5! 

Y(3)=YLUC*1S!PE-1 

X(7)=XLCC«4.G*(ISIDE*.5)  

Y(7)=YLUC+1SIDE-1 
X(9)=XLnC*5-5  +  ISIDE*J.5 

t (9)=YL0C*15lDt-l 
C 

C  FIRST    SETUP    DATA    FOR    SIDE    1    CF    BRIDGE    -    ACCEL  (MC  1=1  ,3 ,5 ,7,9 

C 

DF    45    K=2  ,8 
IF     (K.EQ.3.DR.ILE0.7) GO_TL    4_5 

KAC=KAC*2 
C 
C       XL  IS  ACCEL  LOCATION  ON  PLOT  RELATIVE  TO  SW  CORNER  OF  DECK 


C 


XL=XL*1  .0 
X(K)=XLOC*XL 

YCK)=YLDC«IS1DE-1*P( (1-1 )«16«J,KAC) 
45  CONTINUE 

IF    (  J.EQ.l  .AND. LEG. 1  )         PR  IK  T    4fc  ,  tX  (  ID  ) ,  10  =  1 ,  9  } ,  (Y  CI  D  1  , 1  D  =  1,9) 
4fc    FORPAT     (•    FIRST     FRAME     (1,3,5,7,9)     X  ,Y    ARR  A  YS  •  ,/  ,9  F7  .4  ,/  ,9F7  .4  1 

CALL    FL1NE     (X , Y ,-9 , 1  ,C  ,  3  1 

IF     ( 151 DE  .EQ.21  GO    TC    50 


C 

C  NOW    SETUP    FOR    SIDE     2    OF    BRIDGE     -    ACC EL ( KAC) =2 ,4  ,6 ,8 , 10 

C 

KAC=0 

XL  =  .5 

CALL     PLOT     (XLOC-».5,YLCC-»L0,3l 

5  0  CONTINUE 

XL=0.0 

c 

C  DRAW    DMA    CROSS-BARS 

C 

DO    5b    K =1,10,2 

XL=Xl  +1  .L 

CALL    PLOT (XLOC*XL,YLOC-»P  (  (  I  -1  1  *1 6*-  ,K L  31 

CtLL    PLOT (XL OC+XL*. 5, YLOC+ 1.0 4P(( I- 1 1*1 6* J, K*l) ,2  1 
55  CONTINUE 

SKALE  =1  .L/OELTAV 
C 
C  SETUP    FUR    A12    TOWER    DATA 

MODE3D   Listinq    19    (4    of    5) 
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LEVEL   21  N0DE3D DATE  *  77166 10/23/09 


1(3)=P(1FRN,131  45.0 

X(l>=5.0 

X(2)=5.0 

X(3)=P( IFRH,12)».5  «5.C 

X(31sSEKS((I-l)*l6«  J»26)«Sl<ALE 


C      Xm=SEN5CU-ll*16*J,26l«SKALE  +5 .C 

YC1)=0.67 
C      Vdl-0.5 

Y(2)=1.0 

YI3)=2.4 
C  


C        ENTER  FIRSTV  AND  DELTAV 
C  _ 

X(<il=0.0 

X(5)=1.0 

YU)=0.0 
T(5)=1.0 

CALL  PLOT  CXUl.YU)  ,3) 

CALL  FLIKE  (X ,Y ,-3, 1 ,C  ,2  ) 
C 

C        SETUP  A13  TOWER  DATA 
C 


_X  CI  1=4.5 
X(2)=<».5 


X(2)=<».5 

X<3)=P(IFRM,13)«.5    *4.5 
X(3)=SENS< (l-ll*16+Jt24  1* 
YCll=-0.33 


SKALE    *<i.5 


Y(2)=0.0 

Y  (31=1.4 

CALL    PLOT     CX(iftYCi)  ,3) 
CALL    FLINE     (X ,Y ,-3, 1 , C ,2  I 

IF     (J.EC.l)         PRINT    5<.,CX(ID),lD  =  l,51r<V(lDl,ID  =  l,5l 
54    FORMAT     (•    X,Y    ARRAY    FCR    A13    TOfcER    C AT  A  •  ,10F9.6 ) 
"40         CONTINUE 

70         CONTINUE  


C 

500    CONTINUE 

CALL    PLOT    (C. ,40.0,-31 
RETURN 
C 

_99         PRINT    5000.ALLMAX 
5000    FORKAT(1H1,35HHODE3D— -NO    MOTION,    CONSTANT    DATA    *         eF9.fcl 
STOP    99 
END 
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SUBROUTINE  NEWPRT 

INTRODUCTION 

Subroutine  NEWPRT  provides  access  to  data  recorder  on 
magnetic  tapes  by  an  instrumentation  system  installed  on  the 
Narragansett  Bay  bridge  in  Newport,  Rhode  Island.   Separate 
documentation  describes  the  instrumentation  configuration  at 
that  site. 

The  general  use,  device  assignments,  and  flow  of  the 
subroutine  are  shown  in  the  set  up  and  flow  chart  provided 
herein.   Essentially,  the  subroutine  has  two  functional  modes: 
Initialization,  and  Read.   This  subroutine  must  be  executed  in 
the  initialization  mode  only  once  before  the  first  execution 
in  the  read  mode.   In  the  initialization  mode,  a  tape  number 
card  is  read  from  the  normal  system  input  device.   Using  the 
Julian  recording  date  on  the  card,  a  calibration  file  is 
accessed  and  channel  calibration  constants,  in  effect  as  of 
the  recording  date,  are  selected  for  each  channel.   A  channel 
calibration  table  is  printed  to  indicate  channel/sensor  assign- 
ments and  calibration  constants. 

In  the  read  mode,  each  call  to  the  subroutine  causes  a 
record  to  be  read  from  tape  and  sensor  data  to  be  unpacked, 
calibrated  and  returned  to  the  calling  routine.   The  record 
number  to  be  read  must  be  provided  to  the  routine  for  each  call 
in  the  read  mode;  however,  the  record  number  is  incremented  by 
one  after  each  read  operation  and  therefore,  when  processing 
sequential  records,  only  the  record  number  of  the  first  record 
to  be  processed  is  required  as  a  calling  parameter.   A  status 
flag  indicates  the  results  of  each  read  attempt. 

See  Figures  39  and  40  and  Listing  20. 


OPERATIONAL  NOTES 

The  following  notes  describe  operating  considerations  for 
the  subroutine: 

1.  The  program  is  written  in  FORTRAN  IV  for  IBM  360/370 
computers  under  OS  using  a  G  level  compiler. 

2.  Partial  word  (byte)  manipulations  are  required  to 
unpack  data  from  uncoded  binary  data  records.   This 
was  accomplished  by  equivalencing  LOGICAL* 1  and 
INTEGER* 4  words  in  the  IBM  360.   More  direct  ap- 
proaches may  be  used  on  other  systems.   A  detailed 
tape  format  is  included  in  this  document. 

Note  that  explicit  declarations  of  variable  type  are 
used,  i.e.,  RECNO  is  an  INTEGER. 
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I/O  errors  encountered  using  FORTRAN  under  OS/360 
must  be  cleared.   This  is  accomplished  in  the  sub- 
routine by  branching  to  a  dummy  read  statement  via 
the  ERR  =  option  in  the  original  read  statement.   If 
clearing  is  not  required  in  the  object  system,  the 
dummy  READ  statement  should  be  removed. 

The  program  reads  copies  of  original  data  tapes.   A 
flag  in  byte  2248  of  each  record  indicates  the  status 
of  the  original  tape  record.   The  read  status  flag, 
IRF,  indicates  the  status  of  the  read  operation  as 
follows : 

0  -  record  not  read 

1  -  successful  read 

2  -  I/O  error  on  copy  tape 

3  -  EOF  encountered 

4  -  I/O  error  on  original  tape 

The  subroutine  will  skip  ahead  to  required  record 
numbers.   If  access  to  earlier  records  is  required, 
the  calling  routine  must  rewind  or  backspace  the 
tape  to  the  record  preceding  the  required  record, 
reset  RECNO  to  the  required  record  number,  Set  IFF=2 
to  Reset  CURREC  =  0;  Set  IFF=3  to  Continue  increment- 
ing CURREC  and  call  the  subroutine  in  the  read  mode. 

Data  for  each  record  are  returned  in  the  SENS  array. 
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APPLICATIONS  PROGRAM 


REAL  SENS  (64,43) 
INTEGER  IFF,  RECNO,  IRF 


-  INITIALIZE  - 
IFF  =  1 

CALL  NEWPRT  (IFF,  RECNO, 
IRF,  SENS) 


-  READ  - 

IFF  =  0 
RECNO  =  2511 

CALL  NEWPRT  (IFF,  RECNO, 
IRF,  SENS) 


TAPE 

NUMBER 

CARD 


DEVICE  5 


SUB 
NEWPRT 


CALIB, 
FILE 


DEVICE  11 


CALIB. 
TABLE 


(    DATA  \ 


DEVICE  10 


SUB 
NEWPRT 


DATA  IN 
SENS  ARRAY 


Figure  39.   Subroutine  NEWPRT  Setup 
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READ 


INITIALIZE 


READ 

TAPE 

NUMBER 

CARD 


/NEXt\  Y 
■XT  RECORD  lj^~ 


—Jl 


UNPACK 
DATA 


SET 

READ  STATUS 

FLAG 


_ 


Figure  40.   Subroutine  NEWPRT  General  Flow  Diagram 
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LEVEL   21  KEMPKT  DATE  *  77164  14/14/22 

SUBROUTINE  NEWPRT(lFF,RECN0,lRF,SEfcS,TAPEN0»DATEl 
-INITIALIZES  AND  READS  NENPORT  DATA  TAPE  RECORDS 


REQUIRES  TAPE  ON  UNIT  10,  CALF1L  ON  UNIT  11  AND 

STANDARD  TAPE  NUMBER  CARD  AFTER  SVSIN  DD  CARD 

ROUTINES  CALLED:  NONE 

IFF  =  FUNCTION  FLAG: 

1  -  INITIALIZE 

2  -  READ  TAPE  AFTER  REWINDING  tCURREC  RESET'O) 

3  -  READ  TAPE  STARTING  FROM  WHERE  LAST  CALL  LEFT  OFF 

FOR  EACH  READ 


RECND 

=  REQUIRED 

RECORD  NUMBER.  AUTO 

-INCREMENTED 

—  ~  IRF  = 

READ 

STATU! 

0  - 

1  - 

;    FLAG: 

RECORD  NOT  READ 
SUCCESSFUL  READ 

2  - 

I/O  ERROR  READ  ARC  ( 

CLEARED 

3  - 

EOF  ENCOUNTERED 

4  - 

ORIGINAL  TAPE  ERROR 

SENS  ~    SENSOR  DATA  ARRAYS 

64  VALUES  OF  HIND  SENSOR  CHANNEL  DATA  STORED  IN 
LOCATIONS  1-27  OF  SERS.   32  VALUES  OF  ACCELE ROMETER 
CHANNEL  DATA  STORED  IN  SENS  LOCATIONS  28-37.   CHANNELS 
34, 55, 60, 65, 69, 7C  ARE  STORED  IN  SENS  38-43. 

LCCAL  VARIABLES 


REAL    SENS (64,43  J , INS LCP , INT Ift T, SLOP E C7G ) ,V1 NT ( 70  J .VOLTS, VALUE 

INTEGER     IFF, IRF ,C ALF 1L ,T AP  IN ,R ECNO ,TAPEN0(2 I .DATE  ,I,1NCHAN, 
1  IfcNAMt .INDATE.NAMEflOI  ,  1DATA ( 562 ! ,CHANC ( 70  J , NO 5KP.CURREC , 

1         C0NVRT,DUM,PRNTR1 

L0G1CAL*1    BURST|4>,LQ£DC2248I 

EQUIVALENCE    (LOGO (15 , I  DATA ( 1 H , « BUR  ST { 1) .CONVRT I 
C 

C  INITIAL  IZE    PROGRAM 

C 

CONVRT=0 

1RF=0 

PRNTR1=6 

TAPIh=10 

CALF1L=11 

IF     (IFF  .EQ.2)         GO    TO    950 

IF     (IFF  .EQ.3)         GO    TO    1000 
C 

C  READ    DATA    TAPE    NUMBER    CARD 

C 

READ    9000, TAPENO, DATE 
9000       F0RMAT(2A4,T11,  151 

IFtDATE  .GE. 70300. AND.  CATE.LE. 72161  J    GO    TO     1 

PRINT    9901 
9901       FCRMATIIH1  , 'INVALID    TAPE    DATE"! 
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128 


LEVEL   21  NEWPRT  DATE  «=  7716*  14/14/22 

STOP 
C 

C SET  UP  CHANNEL  CALIBRATION  TABLE 

C 

1       1=0 

2    READ(CALFIL,9001,END=3)     IKCHAN, INNAME ?i NSL0P.1NYI NT  .IWDATF 

9001  FORM  AT  (  12.T11.A4.T21.F8. 4 VT 31 VF8. 4, TS1.I5) 
1FUNCHAN.GT.1  )     1=1+1 
1FUNDATE.GT.DATE  )    GO    TO    2 
CHAN0U+1)=INCHAN 

NAMEt 1  +  1) =1NNAME 

SLOPE (1*1 )=IN5L0P 

YINTt 1«1)=1NYINT 

GC  TO  2 
C 

C PRINT  CHANNEL  CALIBRATION  TABLE 

C 

3      KRITECPRNTR1.9002)  TAPENC.DATE 

9002  F0RMATC1H1,   //T26,» CHANNEL  CALIBRATION  TABLE VT32, 

1    'TAPE  NUMBER  •  ,2A4 /T34 , »RE CCRDED  «.I5,  III  C 5X ,  'CHAN • ,2X , 
1    'SENSOR  •,  4X,  "SLOP  E  •  ,5X  ,  »V- 1  AT •  I  /2X  ,74  (  «-•!// I 

DC  5  1=1,35 

11=1+35 

WR I TECPRNTR 1,9003  1  CH  AND  (  1}  ,!t  AM  E  ( 1) .SLOPE C II ,Y INT (U .CHANO C 1 1 1 , 
1    NAME  CHI, SLOPE  (II  1  ,Y1NT(II  J 
9  003   F0RMATC2X,2f4X,12,4X,A4,3X,F6.4a3X,F8.4)) 
5      CONTINUE 
C 

C INITIALIZE  PROGRAM  VALUES 

C 

RECNU=0 

CURREC=0 

VDLTS=20. 0/256.0 

1PF=2 

RETURN 
C 

C SKIP  TD  REQUESTED  RECCRD 

C 

950  CURREC=0 
1000   NCSKPMRECNO-l  I-CURREC 

IFCNOSKP)  1010,2000,1020 
1010   PRINT  9100 
9100   F0RMATUH1,  BTAPE  BEYOND  REQUESTED  RECORD  SJ 

STOP 

1020  DC  1C30  I=1,N0SKP 

RE  ADC  TAP  IN, 9110 ,END  =  1040,  ERR= 102 1) CUM 
9110   FCRMATCA1) 
GO  TU  1030 

1021  READCTAPIN.9111IDUM 
9111  F0RMATCA1I 

1030      CONTINUE 

CURREC=CURREC*NDSKP 

GO  TO  2000 
1040      PRINT    9102 

NEWPRT   Listing   20    (2   of   4) 
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LEVEL       21  NEWPRT  DATE    «    77164  14/14/22 

9102       FTRMAK  IH1,  »E0F    ENCOUfcTERED  •) 

STOP 
C 

C READ  DATA  TAPE  RECORD 

C 

2000  READ(TAPlN,92O0,END=8C00,ERR  =  7COOnDATA 
9200       FCRHAT(56(10A4) ,2A4) 

2001  RECNC'=RECN0*1 
CURREOCURREC-H 

C 

C OECK    LAST    BYTE 

C 

BLRST<4)=L0GD(2248) 

IFiCONVRT.NE.0)    GO    TO    6000 
C 

C UNPACK    CHANNEL    DATA,    CONVERT    TO    VOLTS,    ENC1NEER1NC    UMTS, 

C THE*    BUILD    SENSOR    GROLP    ARRAY 

JJ  =  1 

1  =  1 

CHK  =  1 

DC    2010     J2=l,32 

K  =  l 

K2  =  26 

DC    2012    J=l,70 

BURST(4  )=L0GDU ) 

IFU.NE.36)    GO    TO    2011 

K*K-27 

JJ=JJ*1 

2011  VALUE  MCLNVRT -128  .C ) *V0L TS ©SLOPE ( J ) *Y INT (J) 
1«M1 

IF(ChK.E0.51    GO    TO    2020 

1F( J.EQ.34.0R.J.EG.fc91    GL    TC    2030 

SENSUJ.K  )=VALUE 

K  =  K  +  1 

CFK  =  CHK-»1 

GC  TU  2012 
2030       1FIJ.E&.34)    SEN SC J2 ,42 )= VALUE 

SENSU2  ,43J=VALUE 

CHK=CHK-»1 

GC  TC  2012 
2020       SENS(J2,K2)=VALUE 

K2=K2«1 

CHK  =  1 

2012  CCNT1NUE 

2010   CCNT1NUE 

IRF  =1 

RETURN 
6000       1RF=4 

RETURN 
7000       READ(TAP1N,9111  )    DUH 

RECNr=RECNO*l 

CURREC*CURREC*1 

1RF=? 

NEWPRT  Listing  20  (3  of  4) 
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G  LEVEL   21  HEMPRT  DATE  =  7716*  14/14/22 

RETURN 

eooo     irf=3 

RETURN 

END 


'NEWPRT  Listing  20  (4  of  4) 
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PROGRAM  RBMPLT 

INTRODUCTION 

Given  a  requested  interval  of  taped  bridge  data  this  pro- 
gram outputs  a  listing  of  maximum  roadbed  accelerations  and 
resultant  wind. 

In  addition  at  least  one  of  two  plot  options  is  output  to 
either  a  Calcomp  plotter  or  Tektronix  CRT  hardcopy. 

The  first  option  (if  NCORL  =0)  plots  up  to  200  points 
(records)  of  six  traces  of  acceleration  versus  wind  data.   The 
traces  include  max  acceleration  per  record  for  accelerometers 
A2  and  A6  plus  average  wind  values  per  record  for  U  velocity  U 
azimuth  lift  angle  and  lift  velocity  for  a  wind  sensor.   (set  up 
for  center  of  bridge  wind  instrument) 

The  second  option  (if  NPOLAR  ^0)  produce  a  polar  plot  of 
wind  direction  and  velocity  at  sensor  three  for  the  8192  data 
points  contained  in  a  9^  minute  long  interval  as  used  to  produce 
a  wind  spectrum. 

This  program  can  process  multiple  requests  from  one  given 
tape  file  but  is  limited  to  200  records  per  request  card  for 
correlation  plots  or  128  records  per  polar  wind  plot  request. 

See  Figures  41  through  48,  Table  12  and  Listings  21  and  22 
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DISK 
CALFILE 


Figure  41.   Program  RBMPLT  Setup 
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Figure  42.   RBMPLT  Flow  Chart 
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Figure  43.   Subroutine  Polar  Flow  Chart 


135 


o 
o 
m 

r- 


ro 
O 

rH 

o 
o 


U5 

1 

CO 

ID 

D 

1 

! 

J 

rH 

rH 

O 

rH 

u 

Eh 

<3 

< 

in 

O 

(N 

rH 

In 

O 

s 

M 

z 

< 

1H 
<1) 

c 

Q) 

ft 
(t3 

EH 

+J 

(0 
TS 

CP 
C 
•H 

-d 

r) 

0 

o 

0) 

an 

4-) 

c 

OJ 

W 

QJ 

U 

w 

1 

Cu  — 

o 

1 

fl 

s 

1 

1     X 

1 

• 

d 

2 

Q 

iH 

<N 

►J 

W 

H 

Pu 

4-> 


O 

T3 
SH 

U 

in 

0) 


(0 
Eh 

Eh 


in 


136 


o 


o 
m 

(N 
rH 
CN 


o 


in 

o 

m 

o 

CO 

O 

rH 

CN 

CM 

co 

s 

in 

rH 

1 

1 

1 

I 

i 

1 

f-t 

VD 

•-i 

y£> 

5 

<-t 

>£> 

f-t 

r^ 

CN 

CN 

j 

o 

u 

E-J 

1 

in 

in 

in 

in 

in 

in 

o 

H 

H 

H 

M 

H 

H 

fa 

o 

2 

M 

I 

U 
0 

Cn 
CO 
<H 
14H 

•U 
0 

rH 

cO 

O 

T3 

ft 

<4H 

(1) 

r) 

U 

n 

ri 

0 

c 

-P 

dJ 

(U 

O 

0 

0 

XI 

JQ 

Cn 

<D 

•rH 

H 

£ 

g2 

c 

u 

•P 

ft 

^ 

3 

•H 

(d 

C 

c 

c 

Cn 

rH 

* 

c 

c 

0) 

u 

01 

a; 

•rH 

■H 

H 

CfJ 

a 

rH 

Cn 

TS 

M 

H 

<o 

■H 

1) 

C 

0 

0 

E-" 

fa 

CD 

fa 

u 

fa 

w 

o 

CTi 

cr. 

CTi 

cr> 

i 

0^ 

i 

1 

<T> 

l-i 

r-i 

rH 

iH 

rH 

rH 

o 

O 

d 

2 

Q 

J 

r-l 

CN 

ro 

"tf 

in 

vO 

W 

H 

fa 

T3 
U 

U 

■M 

W 

S 


in 

01 

u 

3 
Cn 

•rl 

fa 


137 


mo*»«rMX\9g3g9m0>^g}^r>^g3g}f^r^cpg3&g9g9G>g9g3O>9i0g3gJg>g)g9r'tgJ<0r*\g9.£f*>g9 

««~'i^'V'V»-»-»~«-<»"««00"«OOOOOOOOOOOC>C!C>OCiDOOOOOOOOOOO 

O'-fPiPgfMPgPg.-.i-i.-.-i.-i.-iOOOC'O'-'OGOOOOOOOOOOOOOOOOOOOOOO 
000000000000000030000000000000000000003300000 


O  »-  ~  ^.^»r"  (%■  .-M  Pv  fM  it*  ~  „««.-«»,  o  —  .—  i-i»-»-i.-i©QOO  OOOOOOOOCOOOOOO 
OOOOOOOOOOOOOO^OOOOOOOOOOOOOOOOOOOOOOOOOOOOO© 


lu  a 


«i-»^.»«(NiCimi\,^»Nj(Ni~^m»-—  oo»»»»©»-»^ooo©oo©ooooooo©oeo©© 

00003000000003300000000000003300  0300000  0  00300 


o  a     «  «  0  o 

OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO 


<£  jo  g^  g3  gj  g?  g? 


OOOOOOOOO 


ooooooooooooooooooooooooooooooooooooooooooooo 


Z.  gr  I        <"-rwi«mmftjn(\,N^fvi„^,ivM«^«  .-.^m^mOC^  —  oocooooooooooocc 
<  I     3000000300-00  J  OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO 


■™  —  <-p-fMPnsj-rg.-irM<M<~>i-'"-«'-«>-"«-i<-->-»<-'-->«©*-iOO'^C.©OOoOC©000000© 
OOOOOOOOO  0  003000300300000030000000  0  ©J  0  3~>0  0  003 


3 

o 

E-i 

CLI 
s 


^fMfMPgPg««~««~««^0«^«~C©r^C-*w©0O00OO0C_.©0©©0©©0©0C- 

j  _>  o  o    j  vj  _<  _>  o  j  o  o  o  o  o  o  .j  o  o  u  o  w    J    J  o  o  -i   -   ©  o  3  -j  o  o  o  o  o  o  o  o  ~>   o  o  o  -> 


»*«*pr,fMfMfM.~rM«««**—'00-«000©00000000000©000©0©&C©©©C 

oooooooooooooooowooofooooooooooooooooouooooooo 


•H 
Cm 


LU    > 

> 


«« Ill    ■•(»■.• • 


"1  C>    LP.   r<1   J1  'M    \^HnO\OI'l'l^*l^lA'M 


it  tA  if    r^rMp^vr^ga^^^^.  <rp^t^^g3C^grffl&^P^0«^t/^Pgu^LrfMPgf»^g2f^«rwCO^tr'fM*,*^i 
[♦i  ci  «  ^  p^  I  Pg  fM    i    »■*  .g  i*  fn  m  .•fi  *^  **        *i  t>j  #■*!  fH  I  n  w    I    h  CI  «  W  H 


Z   w 

—  > 


X 

JO 


» 

o 

o 

« 

<T 

•J   N    <   ^ 

<o 

o    .-■ 

o  r- 

-J 

lj 

jf 

00 

« 

«■* 

a 

*-* 

m 

■o 

m 

-s 

fPi  (*\ 

pg  o 

r^ 

.2  tm 

O 

>J  m  ^ 

tn 

hS 

m  en 

JH* 

CD 

i»i  <x 

o 

« 

<M 

i\  rg   rg  m 

f, 

m   PA 

<M  fM 

ra 

rg 

*™ 

" 

~* 

""■ 

~~ ' 

m 

i*i 

n-, 

fM 

t\ 

im  Pg 

rn  rri 

fM 

fM  rg 

tMj 

P«  rg  Psi 

"^ 

»-« 

pg  pg 

rgM  h 

«  pg 

O 

© 

pg 

rg  lp»  -c^  co 

OB 

m  Pg 

<e  s? 

w 

m 

•O 

B 

a 

O 

<*** 

r- 

«i 

gj 

hn 

o  O 

00   IM 

■J 

g^  •« 

«"■■ 

«  g  m 

CO 

O" 

gr  ir 

gr  g»  fM 

gr 

m  Pg 

»•! 

m 

IO 

to  r-  ltn  g? 

r— 

O   CT> 

CO    ^ 

r- 

■u 

IT) 

IS 

a-j 

r- 

<r 

© 

r> 

•X) 

a 

a 

O  O 

00   D> 

CC 

r»  p- 

LP) 

■o  -j-  ir 

■0 

m 

gr  i/> 

<0  flD  QD 

o 

oo  Oh 

O 

• 

*NNr\i4r>Uf\i^LJU'iN0^04Hgo<Dm>r\NnO'<Hr/>N'<IM(B<rD4'g'inO>NO>n3e'\M 
•    •    'MfMPgpgrf".  mpi<iNNffiN»<""<«         «C.  i»\f^f\lfgf\<nNf\jNNnN'Vf\(«M»<Mw>"«         ••  IM 


r-rg^isj-i/Ngsp-aJo  o  -im  f.  >T.nor^is>cpo<-<fM'Ti-J'Lng5r-ootT-o-«(Mf<igrLftgjr«cof>o»^pg(ngrLri 


138 


4J 

3 

Sf 

3 
O 

.J 


§ 


M 

3 


139 


CM 


a. 


1 

> 

Q 

3 

tfl 

in 

•«» 

C* 

M> 

«J 

o 

W 

g 

Z 

o 

<c 

* 

4J 

o 

o 

a. 


CO 

<* 

0) 

u 

•H 
fa 


140 


Table  12.   RBMPLT  Variable  Name  List 


Name 

Com 

Type 

Dimension 

Usage 

ACC 

R 

10 

Acceleration  change  within  a  recor<  1 

ACUMU 

R 

1 

Accumulator  for  ' U'  wind  valves 

ACUMV 

R 

1 

Accumulator  for  'V'  wind  valves 

ACUMW 

R 

1 

Accumulator  for  'W  wind  valves 

ADD 

R 

1 

Plotter  angle  increment 

ALEV 

i 

I 

10 

Acceleration  level  flags 

AMAX 

R 

10 

Maximum  acceleration  per  channel 

AMIN 

R 

10 

Minimum  acceleration  per  channel 

ANGLE 

R 

1 

Horizontal  wind  angle  (radiano) 

AXLEN 

R 

1 

Axis  length 

BEGREC 

I 

1 

Starting  record  of  request 

BLNK 

I 

1 

Literal  blank 

BREC 

R 

1 

Beginning  record 

BVALVE 

R 

1 

Lower  valve  of  trace 

CARDIN 

I 

1 

Card  input  unit 

DATA 

R 

6,200 

Data  array  for  correlation  plot 

DEGR 

R 

1 

Angle  for  plot 

DEGREE 

R 

1 

Wind  angle  (degrees) 

DELTAV 

R 

1 

Velocity  increase  per  plot  ring 

DI 

R 

1 

Circle  parameter 

DIRl 

R 

1 

Horizontal  wind  direction 

DIR2 

R 

1 

Vertical  wind  attack  angle 

ENDREC 

I 

1 

Ending  record  of  request 

EREC 

R 

1 

Ending  record 

FILE 

R 

1 

File  number  for  plotter 

FILE  NO 

I 

1 

File  number 

FIRS TV 

R 

1 

Lowest  wind  value  to  plot 

FNO 

R 

1 

File  number 

FXLOC 

R 

1 

X  offset  for  polar  plot 

FYLOX 

R 

1 

Y  offset  for  polar  plot 

I 

I 

1 

General  index 
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Table  12.   RBMPLT  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


IBUF 

ICH 

I  DATE 

II 

IFF 

IPLR 

IREC 

IRF 

I  TAPE 

J 

LEVI 

LEV2 

LEV  3 

LINES 

LSREC 

N 

NCORL 

NDECM 

NMIN 

NP 

NPOLAR 

STAR1 

STAR2 

STAR3 

PSIZE 

TAPENO 

RADl 

RAD2 

PRNTRl 

R 

RADCON 


I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

R 

R 

R 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

R 

I 

R 

R 

I 

R 

R 


4000 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2 
1 
1 
1 
1 
1 


Plotter  buffer  storage 

Current  trace  being  plotted 

Date  of  tape 

General  index 

Function  flag 

Counter  of  polar  data  points 

Record  counter 

Read  status  flag 

Tape  number 

General  index 

Low  acceleration  level 

Higher  acceleration  level 

Highest  acceleration  level 

Line  counter  for  each  page 

La  test  record  processed 

Number  of  data  points  to  polar 

Correlation  plot  flag 

Number  of  places  to  right  of  dec. 

Number  of  minutes 

Number  of  points 

Polar  plot  flag 

Literal  * 

Literal  ** 

Literal  *** 

Overall  plot  scaling  factor 

Tape  number 

Radius  1 

Radius  2 

Printer  unit  assignment 

Radius  length  to  a  data  point 

Radians-to-degrees  conversion  fctr 


142 


Table   12.      RBMPLT  Variable  Name   List    (continued) 


Name 


Com 


Type 


Dimension 


Usage 


SPEED 
REC 
RECNO 
SENS 

SENSR 

THI 

TINC 

TINCM 

TITLE 

TIMCHI 

TLEN 

TNO 

TVALUE 

UNITS 

VELl 

VEL2 

VSCAL 

Wl 

W2 

X 

LLOC 

XT 

XV 

Y 

YHI 

YLOC 

YV 


R 
R 
I 
R 


R 

R 

T 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 


1 

1 

1 

64,37 

1 

1 

1 

1 

6 

1 

1 

1 

1 

6 

1 

1 

6 
8192 
8192 

1 

1 

1 

1 

1 

1 

1 

1 


Resultant  horizontal  wind-velocity 
Record  number  for  plotter 

Current  record  number 

Array  containing  current  raw  data 
record 

Sensor  number 

Max  excu  excursion  from  baseline 

Plotter  increment 

Plotter  increment  per  minute 

Trace  titles  for  correlation  plot 

Height  of  tick  mark  traces 

Axis  length 

Tape  number 

Upper  value  of  trace 

Trace  units 

Resultant  horizontal  wind  velocity 

Vertical  wind  velocity 

Scale  per  reference  excursion 

Wind  ' U'  data  array 

Wind  'V  data  array 

X  coordinate  of  a  data  point 

X  offset  for  polar  plot  center 

Location  of  next  tick  meark 

X  distance 

Y  coordinate  of  a  data  point 
Baseline  height 

Y  offset  for  polar  plot 

Y  distance 
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LE  V  EL 2 1 RAIN OAT  E  c  77164 19/21  / 16 


PRIMS  KAXIHUH  ROADBEC  ACCELERATIONS  AND  RESULTAtll  WIND 

THEN  ALSO  PLOTS  200  PTS  IREC5)  OF  #2  ,A6  .UVEL.UAZ • L 1FT  AN&.LIFT  VEL 

OR  A  POLAR  PLOT  OF  WIAC  ISENSOR  31  DIRECTION  AND  VELOCITY. 


ROUTINES  CALLED:  SITKA,  POLAR 


PROC.  BY  CHUCK  GERHARCT    5  .T  .A  .  ___197fc 
MODIFIED  BY  DUANE  NELSON   S.T.A.    1977 


LOCAL  VARIABLES 

DIMENSION    IBUF<4000),DATA{6,200),V5CALt6),TITLE{6!,UNITS(61 
REAL*8    RADC0N,ACUNU,ACUMV,ACUMtetVELl,VEL2,DIRl,DIP2 
REAL    HI  (6192)  Bki2(8192> 
R  E  A  L    5  E  N  S ( 6^ , 37  )j  ACC1J  0I,AM1M 101 .IHAXt 10 1 ,LE VI tl EV2 .IEV3 


INTEGER    TAPEN0(2J .FILENO 

INTEGER    CARDlNfPRNTRl,IFF,RECNL,IRF,BEGREC,E§SDREC  ,L  1NES  ,LSREC  , 
■       STAR1  ,STAR2fSTAR3,BlNK,ALEV{10) 

DATA    TITLE/»A2»,,A6«,  »UVE L  •  , 'UAZ ■ , «L ANG • , "LVEL B/ 

DATA    UN  ITS/  •G,,,G,,,KPF',,D  EC  •,  »DEC  •,  •UPh9/ 
J^A T  A    ST  A R 1  /  *»»/,  S  TAR  2  /  •  •  •_•  /_,STAR3/«*  »»'/,  B  L_W  K/»    *i 


C 

C 1NITIAL1ZF  PROGRAM  AND  DEVICES 

C 

CARD1N=5 
PRNTR1=T 
RADCL'N  =  180.0D0/3.1A159D0 


LEV1=0.010 
LEV2=0.030 
LEV3=0.C50 
V5CAL(1)=-1 
VSCAL  C2 )  =  .l 

VSCALO)  =30^ 

VSCAL C4 1=75- 

VSCAL<5)=<.5. 

VSCAL(6)=15. 

IPLR=0 

CALL     PL0TS(lbUF,<»000,6) 

CJLL    NEWPENU) 


1FF=1 

CALL  SlTKAtIFF,RECN0,lRFtSEN5.TAPEK0,!DATE I 

READ  DATA  REQUEST  CARD 

SET  NCORL=U  TO  SKIP  WIND/ACCEL  PLOT  OR  NPCLAR=0  TC  SKIP  POLAR  HIND 

000   REArtCAPDIK,91u0,END  =  P000I  II  APE , F1L END ,B EGR EC , EN DREC .NCORL .NPOLAR 
9100   FCRKATC615) 

RECNU=PEGREC 

NP  =  EKDP-EC-EEGRLC 

IF     (NP.GT.200J  NP=200 

IREC=0 

LINCS=61 

RBMPLT    Listing    21     (1    of    5) 
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J.EVEL       21  .   _._      MAIN BATE    «   77lt>4 19/21/16 

REWIND  10 
IFF=2 

PRINT  105fNP,BEGREC,TAPENC,FILENr 
105  FCRMAT<//»  NP=«,15,»  STARTING  RECNC%15,«  OF  TAPEa,2A4,»  FILE", 12) 


1NT1AL1ZE  PLOTTER 
USE  FACTLR=0.67  FOR  CCRRELATION  PICT  ON  TEKTRONIX  iFOR  C0P?  =  .4< 
ORIGIN  IS  2.0  INCHES  IFULL  SCALE!  TO  LEFT  OF  TRACE  STARTS 

IF  (NCORL.EQ.l)    PSI2E=G.67 
IF  iNPCLAR.EQ.l)    PS1ZE*1.?4 


CALL  FACTOR  CPSI2E) 

CALL  PLOT<0.,0.,-3) 
C 

C  PLOT    TICK    MARKS    FOR    CCRRELATION    PLCT,    IF    LSEO 

C  H0R2    SCALE    =20    PTS/1NCF    (REOUCEDI       TICK    NARK=1A    RECS 

C 


IF    CNCORL.EQ.O)         GO    TC    2000 

TINC=.1C 

TLEN=TINC«NP 

TINCP=T1KC«14. 

KNIN=NP/14 

JJMEH1=15.5  

CALL    PLOT     (2.,  TIM  EH  I, 43) 
FILE'FILENO 


CALL    NUMEER    ( 1  .3.T1MEF 1* .1 , .21 ,FI  LE .0 .,-1 J 

CALL    SYMBOL    ( 1 .fc ,T I MEF I ♦ .20 • .21 . 1 3 ,9C . . -1 ) 

REC^BEGREC 
CALL    NUMBER    ( 1_.B _,  T  IMEU  ♦  .1  ,.2  1  ,R  ECO  .  .-II 

DC  "140  "J»"l,2 

XT=0. 

DC    130    I=1,NMIN 

XT=XT*TINCM 

110   CALL  3YMB0L    ( XT *2  .0, T  1MEF  I  ,.14,13 ,C .,-1 ) 

CALL     PLOT    (2.,G.,+3) 

TTHFF1=C3 
140    CONTINUE 
C 

c 

C      PLOT  CORRELATILN  HEADERS  (A2  ,A6  ,OVEL  ,UAZ  ,L  I  FT  ANCLIFT  VEL  I 
C 

TH  1=1.0 

NDECM=*2 

DC  200  ICH=1,6 

YHI=16.5-(2.5*ICH) 

IF  C1CH.GE.3)    NDECM=-1 

TVALUE=*VSCAL(1CH) 

BVALUE  =  -V  5C AL  C 1CH  ) 
C        UVEL  BASE  =  30.  MPH 
C        UA2  BASE  =  175.  DEGREES 

IF  <1CH.E0.3)    TVALUE=*V5CAL(3I*3C. 

IF    I1CH.EQ.3)         BVALUE=-V5CAL(3M3C. 
IF     (1CH.EQ.4)  TVALUE»«VSCAL(4M115. 

rrnncH7¥Q.4i       b  value  =-*5Calc<.i*it5. 
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LEVEL   21  Ml*  DATE  «  77164  19/21/16 


CALL  NUMBER  ( 1  .3  ,  YH  I  *TH  I  ,  .14 , TV ALUE ,0  - , NDECH I 

CALL  SYMBOL  (2.C,YH!*TM  ,.14, 12,S0.,-1) 

CALL  PLOT  C2.0.YHI-THI t+2) 

CALL  SYMBOL  (0  .  8 , YH  I  ,  .2 8  ,7 1 U E I  I CH ) ,0 . ,4 1 

CALL  SYMBOL  (  1  .  3  ,  YH  1  -  .2  5  ,  .21  ,UM  T  S  (  1  CH)  ,U  .  ,4  ) 

C*LL  "PLOT  "1270  7YH  17*31    — ~ 

CALL  PLOT  (2.0*TLEN,YM  ,«2) 

CALL  PLOT  (2.0,YHl,+3) 

CALL  NUMBER  ( 1 .3 , YH I -7H I > .14 ,8 V ALUE ,0 . ,NDECH ) 

CALL  SYMBOL  (2  .0  ,  YHI  -TH  .  .14  ,  12  ,90  .  ,-  1 ) 
200  CONTINUE  

CALL~PL07  ~l  2  707077*37 

PRINT  205 
"205  EDRKAT  «e  PLOTTED  HE  ACER  5 ,5CALE S  A*D  TIK  HARKS  ■ ) 
C 

"C READ  DATA  RECORD 

C 


~TOOD    CALL    SITKXTTFT  76ECNC  ,TRF .SENS .TAPEAO  ,  IDAT  ET 

!FF=3 

lFt  1RF.NE.1 )    GO    TO    70CC 
C 

C---—  INITIALIZE  RECORD  ACCUMULATORS 
C 


J=0 

DC  2010  I =1 e10 

J  =  J*2 

AMINU  J=SEN5tl,J) 

AMAXCI )=SENS(1,J) 

2010   CONTINUE 

ACUKU=C .ODO 
ACUMV=0  .ODO 
ACUMW=0  .ODO 

c 

C -ACCUMULATE  U.V.W  AND  FIND  KIN, MAX  ACC 

C 


DO  2020  1=1,64 
IPLR=IPLR*1 

IF  (IPLR.GT.8192)    CC  TL  215 
Wl(  1PLR1=SENS( 1,13) 
k2(  1PLR)=SENSC1,15) 
215  CONTINUE 

ACUHU=ACUMU+DBLE(  SENS  (1,13)  ) 
ACUMV=ACUMV4DRLE(SfcNSU  ,15)  ) 
AC UMK=ACUMW*DBLE( SENS (1,11) ) 
I  1  =  C 

DT  2020  J=2,20,2 
11=11*1 

IF (SENS (J, J). LT  .AH  IN  (II  )  )    AKIN  I  1-1  I -SENS  (  I  •  J  I 
IF  (SENS  (I ,J).CT.AHAX(1I ) )    AMAX ( 1 1 )  =  SE NS ( 1  , J ) 
2C20       CONTINUE 


CALCULATE     RECORD    STATISTICS 


ACUHL=ACL'HU/fc4.0D0 
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L E V E L  _?  1       Ml N ftAIJ    «    77J 6 « 19/21/1fc 

ACUPV=ACUMV/6A.0DC      .    ... 

ACUVW=ACUHW/b<i.0D0 

VELl=DSQPTCACUHU*ACUHU*ACUHV«ACLmV)  .     . 

D1R1  =(RA0CGN*DATAN2(ACUHU.ACUMV))*i5.OD0 
Yf  L2=ACU*W 


DIk2  =  (RA[>C0N»DATAN2(ACLMkfVELl)  J 

DC    ?C30    1=1,10 

ACC  (I  )*ABS(AHAX(I  }  -AH  IN  (11) 

ALEV(1 )=BLNK 

IF(ACC(1)  .LT.LEV1)    60    TC    203C 

ALEV(  D-STAR1 


1F(aCC(1).GE.LEV2)    ALEVC1J=STAR2 
IFUOCd)  .GE.LEV3)    ALEVdl  =  STAR3 

2030   CONTINUE 

C 

C PRINT  DATA 

C 


3000   IFU1NES.LE.60)  GO  TO  3010 

WR1TE<PRNTR1,9300» 
S300   FORPATdHl.TT.'REC'.TlS.^ORJZ  KINC  BvT30ifLiFT  VECTS 

-   T70,»MAX  ACCELERATION  D  1FFERENC E »/T13  ,'U  •  ,T16 » 
C     -   T70,»MAX  ACCELERATKN  Tl  FFERENC  E  VT7,  "NT  .  »  ,T16  , 
-   *AZH  VEL»,T30,'ELEV   VEL  '  »T<i5  .  '  Al  '  ,6X  .  ■  A2  e  .6*  ,  'A3  '  . 


-  6XtaA4"t6X.  •A5>v6XtaA6*v6X,'A7a,eX,*A6*,6XraA9*,6Xa 

-  _aA10,/T5.120la-a)/) 
LINE5-5 

3010       LSREC=RECN0-1 

WRITE (PRKTR  1,9301  1    L SP EC ,ACUMU,D 1 Rl , YEL 1 ,0 IR2 ,VEL 2 , 
_    ____ <  ACC  <  I  l_t_ALEV_m.il  «lil0  1 


9301    FCRMATd5,l5,T12,F3.0  ,T1  6  ,FA.0  ,2X  eF3  .0.T3C  ,  F4  .0  ,2  >  ,F3  .0  ,T44  , 
-1C(FA.3,A3,1X)  1 

L1NES=LINES-»1 
C 

C        ACCUM  PLOT  DATA  ( A2  ,A6  ,l)VEl  ,0A2  ,L  I  FT  ANCtLIFT  VEL8 
_C 

1REC=IREC*1 

DATA(1,IREC)=ACC(21/VSCALC1) 

DATA  (2,  IREO=ACC(6l/V5CALC2) 

DATA (3, IREC)=tACUMU-3C.I/V5CAL €  3 1 

DATA  (A,  IREC)  =  CD1R1-175.)/V5CALU) 
DATA(5, 1REC)=D1R2/V5CAL(5) 


DATA (6, 1REC)=VEL2/VSCAL(61 
IFtRECNO.LE.ENDREC)  GC  TC  2000 
IF  CNCORL.EQ.O)    GO  TO  1000 

C 

C        PLOT  6  TRACE5  2.5  INCHES  APART 

C 


DO    400     ICH=1,6 
YHI=16.5-(2.5*ICHJ 
CALL    PLOT     (2.VYHI_*3J 

X  =  0. 

DC    350     1  =  1  ,NP 

_X=_X*TINC 

Y=DATAIICH,I1 
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LEVEL       21  WAIN    ._     DATE    =    77U4 19/21/16 

IF  (Y.GT.1.0)    Y  =  1.Q 

Y=Y*YH1 

CALL  PLDT  <2.*X,Y,*2) 

350  CONTINUE 

<»0 0  _C  C N  T  1  N U  E 

GO  TO  1000 
C 

C ERROR  AND  END  PROCESSING 

C 

7000   PRINT  9700 

97U0   FGR*AT(»  ABNORMAL  DAT*  READ") . 

GO  TL  200C 
8000   PRINT  9600 

9800   FORMAT(»  PROCESSING  COMPLETE8* 
C 

C      PLOT  WIND  DATA  IN  PDLAR  FORM 
C 


IF  (NPGLARoEQ.O)    GO  TO  9999 

CALL  PLOT  IO.»0.|-3) 

XLOC=1.0 

YL0C=1. 

FIRSTV=C. 

DELTAV=10. 


DELT*V=2C  . 

KH  =  3 

ENDREC=BEGREC+127 

N=tENDREC-BE&RfcC*l)s6^ 

N=8192 

CALL    POLAR  CFIRSTV.DELTAV.BEGRECENCREU  IT  APE  s,FlLFNO,ICH,XLOC, 


1  YLDC.kl.W2»N) 

WRITE(7,9900) 
9900  FORMAT  (•  POLAk  PLDT  0L5£  COMPLETED8! 
9999  CALL  PLOT  (0.,0B,9991 

STOP 

END 
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LEVEL       21  PCLAR  DATE    =    7716*  19/21/16 


SUBROUTINE    POLAR ( FIR STV ,C ELTAV ,BEGR EC .ENDREC . 1TAPE .FILENQ, I SR > 
~ 1         TXLOf.FYLOCWl  ,W2  ,R  ) 

THIS   ROUTINE   PLDT5    A    160    BEGREE    HISTOGRAM    OF  RESULTANT 

WIND    VELOCITY    AND    ANGLE    CN    A    4-INCH    RADIUS.    I6*H1    X   9-W1DE1 

ROUTINES    CALLED:    NONE 

Wl  :    ARRAY    CONTAINING    U-C0KPLNEN1    WIND 

W2         :    ARRAY   CONTAINING    V-CDKPCNENT    WIND 
FOR    UP    TL    40    HPH    WINDS    USE      DELTAV=1C. 

FTJtt  TJp-T0~SD"FPKTnND5  TJ5E  ~T3ILTAV  =  20  . " 

F1RSTV    SHOULD    =    0. 
"    "13R    =    WIND    SENSOR    OF    ii    AND    V   CCHPONENTS. 

T  ~PRDG.  ^Y    DOLLY    GREENE         S  .T  .A  .         1S76 

C 

KFaXTJIT  IT,  W2  ( 1 ) 

INTEGER  I BUF ( 2000 ),BECREC,ENCREC,TAP END,  F  IL END 

AXLFN=4. 

SENSR=ISR 

BREC=BEGREC 

EREC=ENDREC 


TN0=1TAPE 
FNO=FILENO 

—  --SCALE  AXIS  ACCORDING  TC  VALUE 

WRITE(7,9000)  F IR STV  ,C tL T AV 


9000   FORFAT(«  POLAR  PLOT  F  1RSTV  :  •  ,F6  .3/ ■  DELTAV: •  ,F6  .3  J 

C 

C      SET  PLOT  ORIGIN  USING  OFFSETS  FOR  TEKTRONIX 

C 

XL0C=4.3 
TL0C  =  2.0  

call  Plot (fxloc*axlen,fyloc»-3) 
call  axmxloc-axlen.vloc.lh  ,-1  ,  a)  l  e  n  ,  0  .  , 
1       f1rstv*axlen»deltav,-celtav) 
call  axiscxloc.yloc.if   ,- 1  ,axl  en  ,  0  .  ,f  1r  st  v  ,delt  av  ) 

C 

C DRAW    ANGLE    DIVISIONS    AT    EVERY    15    DEGREES 

C  SIN     (15    DEG)=.27,       CCS(15    CEC)=.S6 

C 

ADD=.04 

or  20  1=1,11 

CALL    PL0T(XL0C,YL0C,3J 

CALL    PL0T(XL0C,YLOC,3) 

RAD1=I*15»3. 14159/180. 

RAD2M.570795-RAD1 

XV=CLS(RAD1)*AXLEN 

YV=5IN(RAD1J*AXLEN 

XV=XV*XLOC 

YV=YV*YLLC 

CAL1    PLOT     (XViYVtZ) 
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L  E  V  F  L 21 POL  A  R  DATE  -    77164 19/21/1  6 

DEGR=90-J«15  _       _  

1FU.GE.6)    ADD=ADD+.07 
XV=XV*CGS(RAD1)*ADD 
TV=YV+SiN(RADl J^ADD 
CALL    PL0T(XLOC,YLOCj3) 


CALL    NUMEER(XVtYV,.I05,DE€-R,C.,-l  ) 

20  CALL    SYME0Lf999.,YV+.C7     ,.07    flHC,C.,l) 

C 

C DRAW  RINGS  ON  GRAPH 

C 

CALL  PL0T(XL0C,YL0C,3) 

01=0.5 

CALL  C1RCL  CXL0C*1.,YL0C,0.,  180  .  >1  .  .  1  .  ,  D  1  1 
CALL  CIRCL  (XLDC-2..YLCC,  18C  .  ,0  .  ,2  .  ,2  .  ,0  I } 
CALL  CIRCL  (XLQC«3.,YL0Cf0.t  180 . ,3 . ,3.  ,0  I ) 
CALL  CIRCL  (XL0C-4..YLCC,  18C . ,0 .  ,4  .,4  .  ,0  1  I 
CALL    PL0T(XLOC,YLOC,3I 


C 

C DRAW    TITLES    FOR    GRAPH  _ 

C 

CALL    SYM£0L{XLCC-2.5,YLQC-0.5,.i*»,38HyiND    ANGL  E    VS.    RESULTANT    KIND 
1    VEL0ClTYfC.,381 
CA_LL_SYMEDL  (XLDC-AXL  ENjYLOC-1  .C,  .  10  »8KRECCRD:     ,C..S  }  

CALL    NUMB ERC 999., 999.  ,.1C,B RFC, 0..-1  ) 

CALL    SYMBOL (999. 2 999  *  ,  s 1 C » 1H- SC . , 1 J 

CALL    NUM&ER(999.,999.,.1C,EREC,0.,-1) 

CALL    5YMt0LULDC,YL0C-l.C,.10,8HTAFE    NC:.C.V6) 

CALL  NUMBER (999., 999... 1CTNL.C..-1 ! 
CALL  SYMtOL(999., 999... 1C,1H-.C.,1) 

CALL    NUMBER(999.,999.,.rc,FNC,0.s-l J 

CALL    SYMEOL  (XLDC-AXL E*  , YLCC-1  .2  5,  .1 0 ,9HCH ANNEL  :     .  C=*9  ) 

CALL    NUMBER  1999., 999.,. 1C , SEN 5R ,0 . ,-1 ) 

CALL    5YMP0LC999.,999.s.lC„3!Hl/v:C  ,  ,31 

CALL    PLOT  CXLUC.YL0C3) 

WRiTE(7  ,92001  


9200       FORMAT  UH1  ,8    i NDE  X  *  ,T  1  0  ,  RADIUS  •  ,T2 5  ,  »RAD  1ANS  •  *T4C  ,  "U-COHPONENT  », 

1  T55,8V-CUMPLiNtNTif~no,t,REiULT.VEL,,T85,,ANGLE,y) 

C 

C —SETUP    DATA    POINTS    FDR    PLCTTifcG    (WITH    DATA    OFFSET    FOR    TEKTRONIX! 

C AND    PRINT    THE    FIRST    25    POINTS. 

C _ _    __ 

DC    300    !  =  1,N 

SPEED=SQRT(W2U)**2*feiHl!«s2) 

ANGLE =1  .57079  5- (    ATAN2 CU2 ( ! } * Kl ( 1 ))) 

DEGREE = ANGLE*! 60 c/3. 14 159 

R=SPtED/OELTAV 

X=R*COS (ANGLE ) 

Y=R»S1N  IANGLE) 

IF     (I  .GT.25)  GO    TO    280 

WR17EU.9  3C0)     1,R, ANGLE.  W1(I),W  2(1 '..SPFED, DEGREE 

9  3PC       FrRMAT(lX,I5,T10,6(Fir.6,5X)J 

280    X=X«XLDC 

Y=Y*YL0C  _  

300  CALL     SYMtOLCX,Y,.07,lFX,C.,l! 

[ '  T  i>f  *- 
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PROGRAM  RHARM 


INTRODUCTION 

RHARM  gives  the  fourier  coefficients  for  an  input  time 
series  using  the  IBM  subroutine  HARM  and  then  unscrambling 
indices . 

See  Figure  49,  Table  13  and  Listing  23. 
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f     ENTRY    J 


INITIALIZE 
VARIABLES 


CALL 
HARM 


SHIFT 

LAST  HALF 

OF  ARRAY 


CALCULATE 

APRIME 

COEFS 


CALCULATE 

SECOND 

COEFS 


SHIFT  BACK 

LAST  HALF 

OF  ARRAY 


(    RETURN    J 


Figure  49.   RHARM  Flow  Chart 
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Table    13.      RHARM  Variable   Name   List 


Name 

Com 

Type 

•     1 

Dimension 

Usage 

A 

R 

Passed 

Input  data  array 

AP1IM 

R 

1 

Coefficient  for  first  stage 

APIRE 

R 

1 

Coefficient  for  first  stage 

AP2IM 

R 

1 

Coefficient  for  first  stage 

AP2RE 

R 

1 

Coefficient  for  first  stage 

CUM 

R 

1 

Coefficient  for  second  stage 

CIRE 

R 

1 

Coefficient  for  second  stage 

CNIRE 

R 

1 

Coefficient  for  second  stage 

CNIRM 

R 

1 

Coefficient  for  second  stage 

CEE-OH 

R 

1 

A  trig  function 

DEL 

R 

1 

II/number  of  points 

FN 

R 

1 

Number  of  frequency  points 

I 

I 

1 

General  index 

IFERR 

I 

1 

Returned  error  flag 

IFSET 

I 

1 

Parameter  for  HARM 

INV 

i 

Passed 

Work  area 

JO 

I 

1 

General  index 

KO 

I 

1 

NTOT+1 

KI 

I 

1 

General  index 



K6 

I 

1 

General  index 

K8 

I 

1 

General  index 

L 

I 

3 

Sets  HARM  3  dimensional  array 

sizes 

M 

I 

Passed 

Size  of  A  is  2*  (2**M)+4 

NT 

I 

i 

NTO+1 

NTO 

I 

1 

Half  of  number  freq  points 

NTOT 

I 

1 

j  Number  of  frequency  points 

NTOT2 

I 

1 

Number  of  time  domain  points 

S 

R 

Passed 

J  Work  area 

SC 

R 

* 

Cos  of  del 

SI 

R 

1 

A  triq  function 

SIS 

R 

1 

0.0 

SS 

R 

1 

Sin  of  del 

1 
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c 
c 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

r 
w 

c 
c 
c 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


SUBROUTINE  RHARH 

PURPOSE 

FINOS  THE  FOURIER  COEFFICIENTS  OF  ONE  DIMENSIONAL  REAL  DATA 

USAGE 

CALL  RHARH  t A  ,M  ,  INV ,S9 I FERR I 


DESCRIPTION  OF  PARAMETERS 

A      -AS  INPUT,  CONTAI 
2*N*4  CORE  LOCAT 
NUMBERS  ARE  PUT 
OF  A 

AS  OUTPUT.  A  CON 
AO/2,B0=0,AleBI, 
THE  FIRST  2**2  C 

K  -  AN  INTEGER  WHICH 
A.  THE  SIZE  OF  A 

INV  -  A  VECTOR  WORK  AR 
DIMENSION  ONE  EI 
C1/8)*2*C2««M1 

S  -  A  VECTOR  WORK  AR 
THE  SAME  AS  INV 

IFERR  -  A  RETURNED  VALUE 
GREATER  THAN  20. 


NS  ONE  DIMENSIONAL  R 
IONS,  WHERE  N  *  2««ff 
INTO  THE  FIRST  2*N  C 

TAINS  THE  FOURIER  CO 
A2,B2r-.-BAN/2,6N*0 
ORE  LOCATIONS  OF  A 
DETERMINES  TFE  SIZE 
IS  2»«2««M)  +  4 
EA  FOR  BIT  AND  INDEX 
GHTH  THE  NUMBER  OF  R 


EAL  DATA.  A  IS 
.  2*N  REAL 
ORE  LOCATIONS 

EFFICIENTS 
RESPECTIVELY  1 

OF  THE  VECTON 

MANIPULATION 
EAL  INPUT*  VIZ 


EA  FOR  SINE  TABLES  WITH  DIMENSION 


OF  1  MEANS  THAT  M  1 
OTHERWISE  IFERR  IS 


REMARKS 

THIS  SUBROUTINE  GIVES  THE  FOURIER  COEFFIC1E* 
REAL  POINTS.  SEE  SUBROUTINE  HARM  FOR  THREE  C 
COMPLEX  FOURIER  TRANSFORMS 


S  LESS  THAN  3 
SET  =  0 


TS  OF  2*(2**M> 
IMENSIONAL, 


SUBROUTINES  AMD 

HARM 


FUNCTION   SUBPROGRAMS    REQUIRED 


N,BN=0    ARE 
THE    FOLLOWING 


METHOD 

THE  FOURIER  COEFFICIENTS  AO,BO=0 ,A1,B1 , . .. ,« 
OBTAINED  FOR  INPUT  XJ,  J=0 ,1 ,2 ,. ..,2N-1  FOR 
EQUATION  IPI  =  3.1*159...! 

N-l 

XJ=(1/2)A0*SUM  (AK4C0SfPI«J«K/N)«BK*SlNtPI<y»K/N)I«Cl/2}AN{-ll 

K*l 


RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
KHAR 
RHAR 
RHAR 
RHAR 
RHAR 
CFRHAR 
•  ,R  HAR 
RHAR 
RHAR 
RHAR 
ORRHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 
RHAR 


40 
50 
60 
70 
80 
90 
100 
110 
120 
130 
140 
150 
160 
170 
180 
190 
200 
210 
220 
230 
24C 
250 
26C 
270 
28C 
29C 
30C 
310 
320 
33C 
340 
350 
360 
37C 
380 
39C 
400 
41C 
42C 
43C 
44C 
«5C 
46C 


RHARM  Listing  23  (1  of  2) 
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3      AC  II    *  -All! 

DO         6    I     *    1.NT0T2 
6      Ad)    -   AC  I I/FN 

CALL    HARMtA.L.INV.S    ,1 FS ET .1 FERR f 

MOVE  LAST  HALF  OF  ACJ1S  DOWN  ONE  SLOT  AMD  ADD  ACN)  AT  BOTTOM  TO 


21 
52 


GIVE  ARRAY  FOR  A1PRIHE  AND  A2PR1ME  CALCULATION 

DO   52  I-1.NTOT.2 

JQ=NT0T2*2-I 

A(JO)*A( JO-2) 

A(JO+1)=A(JO-1) 

A(NT0T2-»3)=A(1J 

A(NT0T2*4)*AI2! 


104 
110 


C 

C 


114 


116 


117 

500 


FIRST  N  SLOTS 

SECOSD  ft  SIGTS 


CALCULATE  A1PRIMES  AND  STORE  IN 

CALCULATE  A2PR1HES  AND  STORE  IN 

K0=NT0T*1 

00  104  I=1.K0»2 

K1=NT0T2-I«4 

AP1RE*.5«(ACI!«A(K1)) 

AP2RE=-.5«CA{ I«1)*A|K1«1)) 

AP1IH  =  .5M-A( I*1)+A(K1«1)I 

AP2I«*-.5«CA(1!-A(K1»I 

A(I)«AP1RE 

ACl*li*APlIN 

A<K1)*AP2RE 

A(K1«1!=AP21M 

NTO    *  NTOT/2 

NT*NT0*1 

DEL=3.1415927/FLOAT(NTOTI 

SS'SINtDEL) 

SC*COS(DEL) 

SI =0.0 

C0=1.0 

COMPUTE    CIJJS    FOR    J=0    THRU    J=N 

DO    116    1  =  1. NT 

K6=NT0T2-2«I*5 

AP2RE=A(K6)*C0«A(K6«11«SI 

AP2IM=-A(K6)*SI*A(K6*1I»CQ 

CIRE*.5*(AC2*1-1)«AP2RE> 

CIIH  =  .5*CA12*U*AP2IKS 

CNIRE».5«(A(2*I-l»-AP2iE5 

CNII**.5«U(2«1)-AP21M  J 

A(2*I-1)=CIRE 

A(2*1I=CI1M 

A(K6l=CNIRE 

A(K6«1)*-CRIIH 

SI$«SI 

SI*SI»SC«CO*SS 

C0*C0«5C-SIS«SS 


SHIFT   CUIS   FOR    J=N/2*1    TO    J =N   UP   ONE    SLOT 

DO    117    I=1,NT0T»2 

K8=NT0T*4-»I 

AIK8-2IMIK8J 

A(K8-1)~A(K8+1) 

00   500    I*3.NTQT2,2 

ACI!    =   2.    *   Afll 

All    ♦   11    *   -2.    *   MI    ♦   II 

RETURN 

END  RHARM  Listing    23    (2   of   2) 
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IN  REVERSE  ORDER 


RHAR 

610 

RHAR 

620 

RHAR 

630 

RHAR 

640 

RHAR 

650 

RHAR 

660 

RHAR 

670 

RHAR 

680 

RHAR 

690 

RHAR 

700 

RHAR 

710 

RHAR 

720 

RHAR 

730 

RHAR 

740 

RHAR 

750 

RH&R 

?feO 

RHAR 

770 

RHAR 

780 

RHAR 

790 

RHAR 

8D0 

RHAR 

810 

RHAR 

820 

RHAR 

830 

RHAR 

840 

RHAR 

850 

KHAR 

860 

RHAR 

870 

RHAR 

880 

RHAR 

890 

RHAR 

900 

RH  AR 

910 

RN&R 

920 

RHAR 

9  30 

RHAR 

940 

RHAR 

950 

RHA  R 

960 

RHAR 

970 

RHAR 

980 

RHAR 

990 

Kn  Ak 

1000 

RHAR1010 

RHAR1020 

RHAR1030 

RHAR1040 

RH&R1Q50 

RHAR1060 

RMAR107O 

RHARU10 
RHA Rl 120 
RHAR1130 
RHAR1140 

RHAR1150 
RHAR1160 

RHAR1170 
RHAR1180 

RHAR2190 
RHAR1200 
RHAR1210 

RHAR1220 

RHAR1230 


SUBROUTINE  SITKA 

INTRODUCTION 

Subroutine  SITKA  provides  access  to  data  recorded  on  mag- 
netic tapes  by  an  instrumentation  system  installed  on  the  Sitka 
harbor  bridge  in  Sitka,  Alaska. 

Separate  documentation  describes  the  instrumentation  con- 
figuration at  that  site. 

The  general  use,  device  assignments  and  flow  of  the  sub- 
routine are  all  essentially  the  same  as  for  subroutine  NEWPRT 
and  consequently  are  described  in  its  section. 

The  only  different  consideration  for  SITKA  besides  different 
channels  in  different  sequences  is  the  fact  that  the  record  length 
of  Sitka  is  2247  bytes  instead  of  2248  NEWPRT. 

The  difference  is  record  length  which  must  also  be  accounted 
for  in  the  JCL  of  the  user  programs. 

See  Figures  50  and  51,  Table  14  and  Listing  24. 
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Figure  50.   Subroutine  SITKA  General  Flow  Diagram 
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CHANNEL    CALIBRATION    TABLE- 
TAPE    NUHBE"    00TEST14 
RECCROEO    76300 


CHAN       SFNSOR 


SLOPE 


Y-IN1 


CHAN       SENSOR 


SLOPE 


Y-INT 


0 

IU              -1 

1.9568 

0.0 

35 

IU 

-1 1.9568 

0.0 

1 

Al 

■0.0402 

0.0 

36 

Al 

-0.0402 

0.0 

2 

IV              -] 

1.9568 

o.c 

37 

IV 

-11.9569 

0.0 

3 

A2 

■0.0402 

0.0 

38 

A2 

-0.0402 

0.0 

4 

1W               -1 

1.956B 

0.0 

39 

LM 

-11.9568 

0.0 

5 

A3 

■CO402 

0.0 

40 

A3 

-C040? 

0.0 

6 

2U               -1 

1.9568 

0.0 

41 

2U 

-11.9566 

0.0 

7 

A<, 

■0.0402 

o.c 

42 

A4 

-0.0402 

0.0 

8 

2V               -] 

11.9568 

0.0 

43 

2V 

-11.9568 

0.0 

9 

A5 

■0.0402 

0.0 

44 

A5 

-0.0402 

0.3 

10 

2W             -1 

1.9568 

o.c 

45 

2w 

-11.95  68 

0.0 

11 

A6 

■0.0402 

0.0 

46 

A6 

-0.0402 

0.0 

I? 

3U               -1 

1.9568 

0.0 

47 

3U 

-1 1.9568 

0.0 

13 

A7 

•C.0402 

0.0 

48 

A7 

-0.0402 

0.0 

14 

3V               -] 

11.9568 

0.0 

49 

3V 

-11.9568 

0.0 

15 

A8 

■0.040? 

CO 

50 

AB 

-0.0402 

J.O 

16 

3w              -1 

11.9568 

CO 

51 

3w 

-11.9568 

0.0 

17 

A9 

■0.0402 

c.c 

52 

A9 

-0.0402 

0.0 

18 

4U                -1 

1.9568 

0.0 

53 

4J 

-11.9568 

0.0 

19 

A10 

-0.0402 

CO 

54 

A10 

-CC402 

0.0 

20 

<,v 

LI. 9568 

0.0 

55 

4V 

-11.9568 

0.0 

21 

All 

-0.0402 

CO 

56 

Al  1 

-0.0402 

0.0 

22 

4W 

LI. 9568 

0.0 

57 

4W 

-11.9568 

0.0 

23 

A12 

-0.0402 

CO 

58 

A12 

-0.0402 

CO 

24 

5U 

1.9568 

CO 

59 

5U 

-11.9568 

0.0 

?5 

A13 

-0.0402 

0.0 

60 

A13 

-0.0402 

CO 

26 

5V 

LI. 9568 

CO 

61 

5V 

-11.9568 

0.0 

27 

SF  IS 

1.0000 

CO 

62 

SEIS 

1.0000 

0.0 

28 

5a 

LI. 9568 

CO 

63 

5W 

-11.9568 

0.0 

29 

SPAR 

1.0000 

O.C 

64 

SPAR 

1.0000 

0.0 

30 

SPAR 

1.0000 

CO 

65 

SPAP 

1.0000 

0.0 

31 

TtMO 

-4.6400 

CO 

66 

TEMP 

-4.6400 

0.0 

32 

CL:F 

1.0000 

O.C 

67 

CL  :F 

1.0000 

0.0 

33 

LVM 

1.0000 

CO 

68 

CL:Z 

1.0000 

0.0 

34 

PUM 

1.0000 

CO 

69 

CL:* 

I. 0000 

0.0 

Figure  51.   SITKA  Calibration  Table  Output 
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Table  14.   SITKA  Variable  Name  List 


Name 


Com 


Type 


BURST 

CALFIL 

CHAN 

CHANO 

CONVRT 

DATE 

I 

IFF 

I  DATA 

II 

INCHAN 

INDATE 

INNAME 

INS LOP 

INYINT 

IRF 

J 

K 

LOGD 

NAME 

NOSKP 

RECNO 

SENS 

SLOPE 

TAPENO 

TAP  IN 

VALUE 

VOLTS 

YINT 

CURREC 


Dimension 


L*l 

4 

I 

1 

R 

32,    70 

I 

70 

I 

1 

I 

1 

I 

1 

I 

1 

I 

560 

I 

1 

I 

1 

I 

1 

I 

1 

R 

1 

R 

1 

I 

1 

I 

1 

I 

1 

L*l 

2240 

I 

70 

I 

1 

I 

1 

R 

64,    37 

R 

70 

I 

1 

I 

1 

R 

1 

R 

1 

R 

70 

I 

1 

Usage 

Byte  work  array 

Calibration  file  unit  number 

Channel 

Channel  number 

Data  amplitude  word 

Date  of  tape 

General  index 

Calibrate/read  function  flag 

Work  array  for  1  record  of  data 

1+35 

Calib  channel  number 

Calib  card  date 

Calib  name 

Calib  slope 

Calib  Y  intercept 

Read  status  flag 

General  index 

General  index 

Equivalent  bytes  from  IDATA  array 

Sensor  name 

Number  of  records  to  skip 

Requested  record  number 

Array  holding  1  record  of  raw  data 

Slope 

Tape  number 

Tape  input  unit  number 

Calibrated  data  value 

Volts  per  bit 

Y  intercept 

Current  record  number 
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LtV[L       21  MAIN  DATE     =    7713  C  J6/44/42 

.SJS.kLUl  l.r.F..  51  T_KA     nFt-,EEUL,)SP,5EK5aTAPEhL.DATFl 


INITIALIZES    ANV    REaDS    A    51TKA    DATA    TAPE    RECORD 

V£rSi:i      C5/K/77 

requires  tape. li.  ukit  ic,  calfil  en  unit  h  and 

-:- -z SJAM.PA R k_7  *  P.E.  _N  Ufc_fc  E  k    C  A R  D__' AFJ.E  R S YS  IN    DP    * 


IFF     =    FUNCTION    FLAG: 

1  -     INITIAL  HE 

2  -    REAP    TAPE    AFTEF     REklhDlM     (CURREC    RESET=0J 

2    -    REAL     TAPE     STARTING     FPDK     WHERE    LAST     (ALL     LEFT    CFF 


FFCM     =    FEbl'P-LC    RECIFE     M.MBL R .A L TL -INCRE HEMT ED    FER    EACH    READ. 


1RF     =    REM'    5TA1US    fLA(: 

C    -    RfcCCRC    NCI     READ 


1    -    SU( CE5SFUI     REJC 
_?    ~  J  / 1  _.Ul  ^ fc  R  J  E  A  I  J.  N C.   C  L  E_AR_E_D . 
J    -    EOF     ENCOUNTERED 


SCws    =   5cN5:t.    data   array: 

6A  VmLLLS  EF  37  CKAANEL5  IA  DRCER  CF 

CHAN'  Et  CM  T/PLE.  B^  C  I  P  s  S  EN  S  t  1  ,  J  J  =ChANl  I  »  J-  1  )  FCR 

--— J=]-33 ...  ___J=3<f-37  CfiRRESPpNC._LL'..CHA.AS..3f»j35j6.9x.70..  _ 

THERE  ARE  rNLI  22  VALUES  OF  EACH  L  F  THE  LATTER  FOUR 

CHANNELS. 

SL5R'lUTIi\E     SITKft     ( J  F  F  ,  R  E  C  M  ,  1  R  F  9i  Efc  S  ,T  AP  E  hC  ,DAT  E  ) 

LOCAL     VARIABLES  


KF.AI     SENS  (fc^,3  7  ),  INSIEP,  INYHT.SLOFE  (7C  )  ,*!NT  (7P)  ,VCLTS,VALUE, 
•       C»</*(32  ,7?J) 

INTEGER     lFF,CALFILfTAFINfRECAn,lRF,TAPEND(2»fDATEiltlNCHANf 
1NKAK  E«  1NDATL  tNAHE(7C)  ill  tCOrjVRTaIDATA(5bO)  •  J«K  (llvI2rl3t 
L  _CilANJ(JC)_tN"S-KP  t CURREC 

LCG1  C  4 L  *  1 "  "  I UK  S T  ( <♦  ) ",  L  JC  L  (  2  2<»  6'j 

ECUI  VALEi.CE     (LDGD(1)>!DATA(1)  ),(  CON  VR  T  .BURST  (1  )  J 

JRF  =L 

TAP  II.  =  10 

__  *  L_M  L  =  I  1 

IF'  (  IFF  .EG. 2)    GO  Tl)  95C 
IF  (IFF  .tG.3)    IV    TL  1CCC 


IEA[   TAPE  NUYPLR  CARD 


C 

REAL    900UtTAPEM)tDATfc 

9 1, 0 : '       f  t  R «  AT     ( 2  A 4  , T  1 1  ,  15  ) 

IF  (LATE  .CE .72274)    GC     U     1 

PRIM    99C1 

FCR'AT     (lHl.t     INVALID    TAPE    DATE*) 

STOP 


SITKA  Listing  24  (1  of  3) 
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.rVL       21  SITKA  DATE    -  J113C  U/44/42 


L-  -:S1-:;P    Cr^\LL    CALKKMUN    CCN5TAH75 

i  1  =J 

r-EAMCALF  ILi^O-l  i_:«P  =  3)  !»CHAKSINKAFE»IN5LCP«1KY1K1V1MDATE 
-01       F_R'-fT(  I2.T11  ,A4,T21  ,  F6.4.T31  ,  F8  .  A  ,  T 5  1 ,  15  ) 

IF  (  I'-CFOf  .CT.  I)  !=I  +  ] 

IF  (  1'  DATF  .(.T.DATE  )    GU    TO     2 
C  F  A  *  ■' .  (  1  ♦  i  )  =  I  u  f  r  A  i ! 

hH'iHI  +  ll  =  1.VU:-.E 
iLU^£  (  1  +  1  )  =  !;,.SL!  P 
Y  I  *,* T  (  1*1  )  =  ]\Y!  :.T 

ol  _  T.     c  _. 


I 

C »k]',T    Cl.ANNEL     CALltRATKh    TAtLE 

C 

?  ['"IM     9  C C  2  ,  T  A  P  C ».' Q  t  i,  A  T  F 

«>___        F'.F.F  ATCInl  ,  //72t,,« CFAf^.EL    CALI6RAT1CN    TABLE «/T32i 

IMAPJ    uUr'ER     t_2AM/T^J»FECL*DED_Ajli>_    _/77 2 15JL._ChAK !_____, 

2»5EN5iR  '.^X.  ■SLL'PE,,5*,.,lf-IM  M/_X,  74  <•-■)//  1 

L.r   5   i  =  i,?5 

KlMvjC  fCHAN_  (1  )  ,NA"E(  I)  ,5LDFE(  1)  ,Y!KT(1)  rCHAF.T  (II), 
3  ;iv.F  (  1  I  )  ,  SLp[-E  (  1  I  I  ,  Y  I  M  (  J  I  ) 

9;C?       Fr.«*'ATl_X  ,2UX,  J2_MXtfiAf3XjFe  .4,3X,FE  .4  )) 

f  tCMPiUE 

( 

C        - — 1N1TIALI-F     PkrCRA^     VALUES 

C 

p.  r  c  * :  =  j 

ClM_(  =  _  . 

VrLT_  =  _L.n/2«,6.t. 
(.1  i:VKT=t 

i  f  r  = : 

F  rm  !•' 

C _K1P    TL     KFC'JLSTEL:    RECTKC  

C 

9bC     (  IF.?  K=l 
1DL?       F.f  _KP=  (Rttr.'.-l  »-(  l'F.kE( 

IF  (!.:  SKP)     10)  .'  ,2-00, 1C_0 
1C1C       PRIM     91EC 
910? f_R*_T     1^1,'    TAPEEEUNE     KEl  IE  S  7  EC  _R  FC  OR  C  M 

STOP 
1C20      ir    I03U    I=l,NniKP 

F£A,mAPI\,9inif_Rk  =  lC25,fcfSD=l_4l )    PL* 
91U1       KK-MM     („1) 

_T    7"    1 C  3 0 

1C_*_  KFAP(TAPP-,9i01  >     CU"  

1C_C       L'NTl'iUK 

CLRKLr=CLRKEC-»r._SKP 

^P       F^I'T    9  It  2 
9102       FT.k-.AT     (ihlt*    cwF     Ef.CELNTEkEL    CURING    SKIP*) 

SITKA  Listing   24    (2  of   3) 
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LEVEL   il  SITkA  DATE  =  7713C  16/44/42 

C 

C    —  K  f  A  L  TATA  TAFF  REClRL 

t. 

^CwCj       REAL     (TARI\,9CL4,END=f  CC{.ttkk=70CC)    JDATA 

9CC^       Kt/'AT     (5e(10/sM 

C INPUK     C/TM    ClWFkT     U     VILT5     ANt     E  KC  .    LHIT5 

r 

1=1 

P'     ?t  1Q     J  =  l  i3? 

IT    20  Jo    K  =1  ,70 

PiiK.iT.  {4J  =  LCC:D(iJ        ..  ._ 

V* LUE  =  ( CV  N VkT - 1 2c  .  j  ) * V C  L  T  5 

C»-A\  U,K  )=VALl'L*iLi:4  E  (r  )  ■•  Y  1  M  (K  ) 

1  =  1*1 

2.  c  1 1     c :  n  t  i  r  u  [ 
c 

C f-LlLL    SEIvSLR    »kRAY    ._ 


1=1 

LC     ?:3j     11=1,32 
C  Li'.^ACK     OATA     FnP     TIL     <.-  \  JL  Ut  -F  E  k  -J  CAN    CMNN'ELS 

LT     2'.2:     J  =  l  ,3? 
_  .__SFN5  (  lj  J)=Cl  AM  J  1  ,J  ) 

sr\s<  i+: ,  j)=ch;,m  i  i ,  j  o? ) 

*U?G       CTNTIlUE 

C  HANDLE     SINGLE     VALUE     C M * , E L S 

SF\5(1I,3«*1  =CH,\»  HI  ,3*,) 

SE»*5(  II  ,irJ  =l '.„•,(  r  i  ,3«) 

Sri*i<  II  ,;*r  )  =L  »'A  ri  [|J  tfeC  j 
2>F  «M  I  1  ,57)=C»  ANI  J  J  ,7C  ) 
I  =  I+i 

i(j':        LC\T1NUE 

KCC'-I  =KECM  -1 
CLki  EC  =  Cl PKEC  +  1 

I  P  F  =  1  

retlVn 

C  kE/T    A     KCC'jfO    AS    DU^Y     THEK    RETURN 

7  j  u  c     *  I  c  n  ■  =  k  1 1  ki ;  ♦  i 

LLRRcC=CLKP,LC-»l 
R  «■/.::     (Tap  I.\  ,9-ii,51     SUM 
5COf_    Ffk.ATjAI) 

KCT'JhN 
It  Vol       I  R  F  =  i 
k&TUI.K 
EM3 
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PROGRAM  TAP SUM 

INTRODUCTION 

This  program  reads  SITKA  data  tapes  and  prints  summary 
reports  of  the  contents  by  individual  wind  or  seismic  events. 
Within  an  event,  interval  summaries  are  printed  every  30  minutes, 
10  minutes  or  every  INTRVL  seconds  as  requested  by  parameter 
card. 

Within  each  interval  summary,  the  maximum  value,  minimum, 
mean  and  standard  deviation  are  displayed  for  each  channel. 
Each  interval  summary  has  the  channels  arranged  in  order  of  the 
accelerometers  first,  then  the  'U'  wind  channels,  'V  winds,  'W' 
winds,  and  miscellaneous  channels. 

The  tape  summary  displays  beginning  and  ending  record 
numbers  and  time  for  each  interval,  record  numbers  that  have  I/O 
or  time  errors  plus  total  records  and  errors  for  the  whole  tape. 

See  Figures  52  through  59,  Table  15  and  Listings  25  through 
30. 


OPERATIONAL  NOTES 

Besides  inputting  tape  number  and  date,  several  other 
parameters  must  be  set  by  the  data  request  card  for  a  run.   First 
the  number  of  files  to  summarize  must  be  set  and  the  appropriate 
JCL  cards  for  each  file  set  up. 

The  length  of  the  interval  to  summarize  must  also  be 
chosen.   Normally  this  parameter  is  set  for  600  seconds  (10  min- 
utes) the  first  time  run  on  a  tape,  although  short  120  second 
runs  are  sometimes  more  appropriate  to  help  narrow  down  the 
start  of  acceleration  events  for  further  detailed  runs  by  such 
programs  as  RBMPLT.   The  parameter  ISECF  is  set  to  0  or  1 
depending  on  if  seconds  were  recorded  on  a  specific  input  tape. 
Finally  if  for  any  reason  processing  on  a  file  is  to  terminate 
without  reading  all  of  that  file,  an  ending  record  number  may 
be  input  for  this  purpose  (default  value  is  9999)  . 
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Figure  52.   Program  TAPSUM  Setup 
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Figure  53.   TAPSUM  Flow  Chart 
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Figure  54.   EVINIT  Flow  Chart 
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Figure  55.   INTSUM  Flow  Chart 
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Tft»E    SJNRA1Y P|(E      1 

TARE   NUNBER    007983 
RECORDED    7Si80 


RECORD  TINE 

NO  0      H      N      S  CONNER! 


1  47:    6:4?S30  BE&1N   EVENT       1       IMINO) 

60  47:    6X5* r 32  TINE    ERROR.   LAST    TINE-   47s    6:53:49 

2429  I/O    ERROR.   LAST    TINE-   47:10:    4:29 

2430  I/O    ERROR.   LAST    TIRE-   47:10s    4:29 
2490  47:10:    4S29  INTERVAL    SUNNARY      I-    I 

2430  47:10:  4:29  END    E1CRT      1 

2430  0:    3:14:59  EVENT    TOTALS 

2431  47:10:  6S23  IE&IN  EVENT  2  IMIN9) 
2645  47:10:25218  INTERVAL  S4MNARY  2-  1 
2665  47S10:25:18  END    EVENT      2 

235  0:    0818:55  EVENT    TOTALS 

2665  0:    3:35:54  TARE    TOTALS 

2  1/0    ERRORS 

1  TINE    ERRORS 


Figure  58.   Program  TAPSUM  Tape  Summary  Output 
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TAPE   NO. 

007983 

EVENT  NO 

.      1 

INTERVAL 

sumuir     1-  1 

SENSOR 

NININUH 

NAXMUN 

Al 

-0*006 

0.014 

A2 

-0.004 

©.010 

A3 

-0.000 

0.006 

At 

0.002 

0.022 

A5 

-0.028 

0.006 

A6 

-0.003 

0.019 

A7 

-0.019 

0.013 

AB 

-0.019 

0.009 

A9 

0.057 

0.190 

AlO 

-0 .022 

0.003 

All 

-0.251 

0.229 

A12 

-0.003 

0.003 

A13 

0.402 

0.402 

1U 

-12.144 

14.946 

2U 

-8.539 

17.748 

3U 

-47.640 

14*012 

40 

-11.209 

14.012 

5U 

-3  .736 

14.012 

IV 

0.0 

43.904 

2W 

2.602 

41.101 

3V 

4.671 

41.101 

4V 

1  .868 

42.036 

5r 

0.934 

37.365 

IV 

-9.341 

13.078 

2M 

-6.539 

10.275 

W 

-7.473 

12.144 

All 

-10  .275 

10.275 

56 

-12.144 

12.144 

Sf  IS 

0.076 

0.156 

SPAR 

-1 .250 

0.391 

SPAR 

-1 .797 

-0.313 

TENP 

5.800 

6.337 

CL*F 

9.844 

9.922 

CL.Z 

0.0 

0.0 

CltN 

5.000 

5.000 

SPAR 

9.219 

9.3  75 

S>AR 

8.291 

8.438 

IRC 

0.0 

5308*000 

START        47:    6*47.30 
STOP  47.10«    4529 

SURMIOH  3.16.59 


NEAN 


STD3EV. 


0.0035 

0.0024 
-0.0016 

0.0115 
-0.0123 

0.009  3 
•0.0043 
-0.0061 

0.1023 
-0 .0094 
-0.0092 
-0.0004 

0.4020 


3.2700 
4.0908 
3.0675 
2.6995 
7.0260 


21.5187 
22.9343 
22.6629 
22.6454 
12.8486 


2.3736 
2.5782 

2.0049 
0.4108 
0.7595 


0.1534 
-0.4604 
-1.1176 

7.0183 


9.6598 

0.0 

5.0000 

9.2931 

8.3621 

275.6652 


0.3)31 
0.0009 
0.0012 
0.9915 

9  JMS 
04)009 
0.0017 
0.9911 
0.3129 
0.0008 
0.0427 
0.0912 
0.0000 


2  -4247 
2.6142 
8.4857 
2.5212 
2.98  99 


4.5168 
4.3809 
4  JO  96 
4.698S 
6.9795 


1.7374 
1.6023 
1.6184 
1.7225 

2.0289 


03146 
0.1430 
0.1296 
0  3976 


33*15 

03000 
03000 
0.9167 

s.ms 

1103725 


Figure  59.   Program  TAPSUM  Interval 
Summary  Output 
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Table  15.   TAPSUM  Variable  Name  List 


Name 


Com 


Type 


Dimension 


Usage 


ACUMl 

ACUM2 

ARG 

BURST 

CALF I L 

CHAN 

CHANO 

CONVRT 

CURSEC 

CURTIM 

DATE 

DAYS 

DHMS 

ENDREC 

EVBREC 

EVBSEC 

EVENT 

EVINCT 

EVRECS 

HRS 

I 

II 

12 

13 

IBLNK 

I  DATA 

IDAYH 

IDAYT 

IHRT 

IDAYU 

IFLE 


x 

X 
X 

X 


R*8 
R*8 
1*2 
L*l 

I 
R 
I 
I 
R*8 
I 
I 
R 
I 
I 
I 
R*8 
I 
I 
I 
R 

I 

I 

I 

I 
1*2 

I 

I 

I 

I 

I 

I 


38 

1 
1 
4 
1 
32,70 
70 
1 
1 
4 
1 
1 
4 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

1 
560 

1 
1 
1 

1 
1 


Accumulator 

Accumulator 

Actual  IRG  read  from  tape 

Byte  work  array 

Calibration  file  unit  assignment 

Channel 

Channel  number 

Data  amplitude  word 

Current  seconds 

Current  time 

Date  from  tape  number  card 

Days 

Days-hours-mins-secs  array 

Last  record  to  process 

Event  beginning  record 

Event  beginning  seconds 

Recording  event  number 

Event  initialization  counter 

Number  of  records  in  latest  event 

Hours 

General  index 

General  index 

General  index 

General  index 

Blank 

Work  array  for  1  record  of  data 

Hundreds  of  days 

Tens  of  days 

Tens  of  hours 

Days 

File  counter 
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Table  15.   TAPSUM  Variable  Name  List  (continued) 


Name 


Com 


IHRU 

II 

IMINT 

IMINU 

INBSEC 

ICHAN 

I  DATE 

INNAME 

INTCNT 

INTRVL 

INTSEC 

INS LOP 

INSPLS 

INYINT 

IPWR 

IRG 

ISECF 

I  SECT 

ISECU 

ISF 

ITM 

J 

JJ 

K 

LASSEC 

LASTIM 

LITIRG 

LOGD 

LOGT 

LSREC 

MAX 


x 

X 


Type 


I 
I 
I 
I 

R*8 

I 

I 

I 

I 

I 
R*8 

R 

R 

R 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 
R*8 

I 

I 
L*l 
L*I 

I 

R 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
4 
1 
1 
1 
1 
4 
1 
2240 
16 
1 
38 


Hours 

1  +  35 

Temporary  minutes 

Minutes 

Time  at  start  of  interval 

Cal  file  channel 

Cal  file  date 

Cal  file  name 

Interval  counter 

Length  of  data  summaries 

Time  elapsed  within  present  interval 

Calibration  slope 

Interval  samples  counter 

Calib  Y  intercept 

Power  failure  flag 

Inter  record  gap 

Data-timing-contains-seconds  flag 

Tens  of  seconds 

Seconds  (units) 

Ready- for-new-event  flag 

Time 

General  index 

General  index 

General  index 

Last  seconds 

Time  of  last  record 

Literal  •IRG" 

Byte  array  for  data  record 

Byte  array  for  time 

Last  record  number 

Maximum  values  array 
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Table  15.   TAPSUM  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


MIN 

MINS 

NAME 

NFLE 

NLINES 

PAGE 

PRNTIM 

PRNTRI 

PRNTR2 

RECNO 

SECNDS 

SECS 

SEIS 

SENS 

SLOPE 

TAPENO 

TAPIN 

TEMP 

TIERRS 

TIMDIF 

TOTSEC 

TPBSEC 

TTERRS 

TYPE 

VALUE 

VARI 

VOLTS 

WIND 

YINT 

IBNTIM 


x 

X 

X 

i 

X 


R 

R 

I 

I 

I 

I 

I 

I 

I 

I 

R*8 

R*8 

R 

R 

R 

R 

I 

R 

I 

R*8 

R*8 

R*8 

I 

R 

R 
R*8 

R 

R 

R 

I 


38 

1 

70 
1 
1 
1 
4 
1 
1 
1 
1 
1 
1 
64,37 

1 

2 

1 

1 

1 

1 

2 

1 

1 

1 

1 

1 

1 

1 

1 

4 


Minimum  values  array 

Minutes 

Sensor  name 

Number  of  files  to  process 

Line  counter 

Page  counter 

Time  printed  at  end  of  an  interval 

Printer  1  unit  assignment 

Printer  2  unit  assignment 

Record  number 

Seconds 

Seconds 

Title  'seis' 

Array  holding  1  raw  record 

Slope 

Tape  number  literal 

Tape  unit  assignment 

Temporary  variable 

I/O  error  counter 

Time  difference 

Total  seconds 

Tape  seconds 

Timing  error  counter 

Type  of  event  (wind  or  seismic) 

Calibrated  data  value 

Variance 

Volts  per  bit 

Title  'WIND' 

Y  intercept 

Interval  begin  time 
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LEVEL      21  HAIR  DATE    «   77168  12/59/15 

•**«*PROGRAM    TAP SUN ••••*• «««*«#»•«*«•«•« »«••««««•«««•«»:«»•*• »*••••«*>« 

READ    SITKA    DATA    TAPES    ARC    PRIRT    SUMMARY 

REPORT    OF    TAPE    CORTERTS    «V    INDIVIDUAL 

SEISMIC    OR    WIND    EVERTS. 


PROG.    BY    CHUCK    6ERHARDT         S  .T  .A  .    1976 

COMMON    VARIABLES 

COMMON    ACUMlaACUM2vCURSEC.IRTSEC  9 It BSEC .EVBSEC aTP ISEC ,L ASSEC. 
1      T APENO. SENS aM IN aMAXaIR5PLSaPRRTR2a DATE, EVERT, IS F,RECROaPAGEa 
1      NLINES.LASTIMaNAME.CURTItt,EVIMCTaIRBTlMalRTCRT.EVBRECaPRRTRl* 
1      LSREC 

REAL»8    ACUMK36  ) ,  ACUK2  C38  )aCURSEC  *1NTSEC  ,  IRBSEC  vEVBSEC  .TPBSEC, 
1      LASSEC 
REAL    TAPENOI2)aSEHS(6*a31)aRIM(36)aflAX(38),lRSPLS 
INTEGER    PRNTR2.DATE«EVENTtlSFtRECRC,PAGE.RLIRESvLlSTlM(A) . 
1      NAME(70)aCURTIMf4)aEVlRCTalMBTIMI4>aINTCNTaEVBRECaPRRTRlaLSREC 
C 

C LOCAL    VARIABLES 

C 

REAL'S    TOTSECaTIHDIF 

REAL    V0LT5,SLOPE(70)aVIRT(70)aVALUEaCHAN(32a70), 

I  INSLOPaIKYINT 

INTEGER    TAPINaTIERRS.TTERRSaCHANO  (101  tit  UaIltI2»13tLITIRG. 

I I  DATA C 5 60)  aITMU)  , J, K, CO RVRT , IM IN T, 1 M 1NU, IP WR • IHR T . IHRU aIDAYT t 
2IDAYUtISECT,ISECU,       I RG, PRNTIM (6) aC AL FIL .ENDREC ,1 SECF 

INTEGER*:     IBLRK.ARG 

LOGICAL «1    BURST(4)»L0CT(16)aL0GDC2260) 

EOUIVALEhCE    I  LOG  TCI)  aITM  ID)  ,  (LOGO!  1)  alDATA  CI  1 )  • 
6CC0NVRTaBURST(D) 

DATA    LITIRG/«IRG«/ 
C 

C INITIALIZE  DEVICES 

C 

TAPIN=10 

CALFIL=11 

PRNTR1=7 

PRNTR2=8 
C 

C READ    TAPE    NUMBER   CARD    AND    DATA   REQUEST    CARD 

C 

READ  9000,TAPEN08DATE 
9000   FORMAT  CZA4 aTll aI 5  ) 

READ  9100,NFLE, IN TR VL  .ISECF .ENDREC 
9100  FORMAT  C^t  IS  I 

IF  (ENDREC. IE. 0)    ENDREC=9999 

IF  (INTRVL.LE.60)    INTRVL=120 

1FCDATE.GE. 72274!  GO  TO  1 

NR1TE(PRKTP  1,9901) 
9901   FORMAT  (1HJ , • INVA LID  TAPE  DATE') 

STOP 
C 

TAPSUM  Listing  25  (1  of  6) 
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LEVEL   21  RAIN  ©ATE  »  77148  12/59/15 
SET-DP  CHANNEL  CALIBRATION  TABLE 


1=0 

READ(CALFIL»9001eEND=3»    INCHA N , INNAHE . INSLQP , INYI KT tINDATE 
001       FORMAT ( 12  .Til,  A4  »T21.  F6. 4  .T31  ^6.4^51,151 
IFtINCHAN.,GT„ni«l*3 
IKINDATE.GT.DATE  I    SO    TO    2 
CHANC!I*1I=IWCHAN 
NAME ( 1*1 )» INN AM E 
SLOPE U*l  JMNSLOP 

tiwtu  *u-inyint 

GO    TC    2 

c 

C PRINT  CHANNEL  CALIBRATION  TABLE 

C 

3  WRITECPRNTR!99002JTAPEN0S9ATE 

9002  FCRHATC1H1,         //T26,» CHANNEL    CALIBRATION    TABLE »/T32e 

leTAPE    NUMBER    B, 2A4/T34, "RECORDED     e,15*      ///2C5X  ,»CHAN» ,2X , 
28SE«SDReB4X9»SL0PE,95X*»*-lNT8l/2JW?4C9-8B//8 

DO    5    I*l935 
1 1 =  i  +3 5 

WRITE  (PRNTR1 ,9003  !CHARO(  II .NAME t i >, SLOPES  I)  ..VINT  CI  I  .CHANO  II I  If 
INANE t III. SLOPE (II  I.YlNT(Il) 

9003  FORMAT  C2X 82 UX , 1 2,«X  ,A4 83X »F8 .4 e32 9F8 .41 1 

5  CONTINUE 
C 

C— — PUT    NAME    ARRAY    IN    $EHS    GROUP    ARRAY    OS  DER 
C 

12=2 

I3«2 

DP    6    11=1  ,33 

IF  C 11  .E0«14 152  =  1 

1FC  I1.EQ.?9)I2»28 

IFf  U.GE. 30)13*1 

NAMECI1 l-NAMECI2*35) 

I2=S2«13 

6  CONTINUE 
§4AHE«36}=NANE(34I 
NANE(37?=NAME  C35) 
NANE(34)=NAME Ifc9) 
NAME(35)=NAME(70J 
NAMEC38  )=LITIR& 

C 

C INITIALIZE    PROGRAM 

C 

lFLE=i 
10000    CONTINUE 

PA&E=1 

NL1NES=6C 

CALL    HOC 

EVENT=0 

1SF  =  1 

RECNC  =0 

7 IERRS=0 

TAPSUM   Listing    25    (2   of    6) 
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MAIN  BATE    *   77168  12/59/15 


TTERRS*0 

CONVRT*0 

VCLTS=20 .0/2*6.0 

00    10    1=1 #4 

IASTIM(I)~0 

CURTIM(I1=0 
10     CONTINUE 

LASSEC*O.ODO 

IBLNK=0 
C 

C READ  OATA  TAPE  RECORD 

C 
1000    READ    ITAPIN.9004,END*800C,ERROOOO) 

2IDATAV{ ITNII) vl-2,4),ARGtITM|l)»lBLNK 
C900A    FORMAT    CS6U0A4) ,3*1 .A2 ,AI,A2 ) 
900A      FORMAT    (56I10A4) ,3A1  ,«2#2A1 1 
C  IFUBLNK.NE.O)    60    TO    100C 

2000      RECN0*RECN0«1 

LSREC**ECN0-1 

IF    IRECNO.GE.ENDREC)         CC    TO    0000 
C 

C UNPACK   CHANNEL    DATA;    CONVERT   TO   VOLTS 

C THEN    TO    ENGINEERING   UNITS 

1*1 

00    2010    J*l»32 

00    2010    K*1.70 

BURSTC4)*L0G0(I) 

VALUE *C0NYRT-128.0 

CHAN(J,M*VALUE*VOLTS 

CHAN  ( J,K  )  *CHAN  C  J,K  )  «SLOPE  IK  HVINT  IK  I 

1«I*1 

2010   CONTINUE 
C 

C BUILD    SENSOR    GROUP    ABRAY 

C 

1*1 

00  2030    11*1.32 
12*2 

13*2 

DC    2020    11*1,33 
IFU1.EQ. 14)12*1 
1FC  II. EQ. 29)12*26 
IFdl.GE. 30)13*1 
SENS(IVUT*CHAN(11,I2> 
SENS(I«ltIl)«CHAN(IltI2«35) 
12*12*13 
2020      CONTINUE 

SENS(lIt3*)*CHAN(Il,69) 
SENSCI1«35)*CHAN(1I  v70) 
SENS(llt36)*CHAN(IIv34> 
SENS(II»37I*CHAN(UV35) 

1  =  1*2 

2030      CONTINUE  _• 

TAPSUM  Listing   25    (3  of  6) 
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LEVEL      21  BAIN  DATE    «   77H8  12/59/15 

C —CONVERT    TIME    FROM    ALPfcA    ID    INTEGER 

C 

J=l 

00  2040  I=3B13,4 
BURSTC4J=L0GTU  1 
1TM(J}=C0NVRT 

J  =  J*i 
2040   CONTINUE 

iFCISECF.EQ^OHTSC^I^.O 
C 

C UNPACK  TIME 

C 

1MINT=ITNC1!/16 

1NINU=1TMC1)-1MINT*I6 

IPUR-0 

IFUNINT.LT.8IG0    TO    2C50 

IPWR=1 

INlNT=lMlNT-8 
2050       lHRT  =  ITMm/64 

IHRU=ITM{2g/4-iHRTei6 

1  DA  YH*  I  TM  f  2  )  -C  1  TM  i  2  I  /4  )  *4 
IDAYT=ITH{3!/i6 
lDAYU=lTM(3j-lDA¥T^i6 
SSECT=ITMC4S/16 

SSECU  =  ITH  !4?=IS£CT*1& 

IFC JSECT.LT  „8JG0    TO    2060 

3SECTsl5ECT-8 
C 

C COMPUTE    CURRENT    RECORD    TIME 

C 

2060       CURTiMC15=IDAYH*100-»IDAY1«10«lDAYU 

CURTIM(2)-IHRT«10*IHRU 

CURT1M(3}=1NINT©10*IHINU 

CURTIMU)=1SECT»10*ISKU  * 

C 

C TIME    CHECKS 

C 

2065      CURSEC=CURTIM(4J*l.DO«CURTlN(3)*60.DO-»CURTlM42l*3€00.D0* 
Ifc'JRTIMU)  986400  .DO 

TIMD1F=CURSEC-LASSEC 
C 

C CHECK  FOR  NEW  EVENT 

C 

IF  I  ISF.EG.I  1  CO  TO  5010 

IF  (TIMDIF „GT .61.0D01    CC  TO  5000 

1F(T1MDIF«LT.08ODO.OR0"TIMD1F.GT.15.0DO.AND.ISECF.CT  .0)  GO  TO  5000 
C 

C CHECK    FOR    END    OF    SUMMARY    INTERVAL     tEITHER    30   MINUTES    OR    10    MINI 

C 

INTSEC=CURSEC-1NBSEC 

IF(  INTSEC.LT.O.ODO.OR.lNTSEC.GE.mVRL  1         CALL     INTSUM 
I 
C CHECK    FOR    TIME    SEQUENCE    ERROR 

TAPSUM    Listing    25    (4    of    6) 
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LEVEL      21 


III  IN 


BATE    ■    771*8 


.lii    .'S^'d/S^ 


4005 


C 

2070       IF(ISECF.EQ.O)    CO    TO    4000 

lF(Tl«DlF.GE.3.9D0-fl»D.TI«D!f .LE.5.1D0J    CO    TO    4000 

TTERRS=TTE*RS*1 

UR]TEfPRNTRlt9006lRECN0,CURTlM,LASlIM 
9006       F0RMATCTll9lStT21»I3t3C*:svl2).T38» 

4»TIME    ERROR.   LAST    TIME-* tI3.3l 9 ?• ,12 J 1 

KLINES=NLINES*1 

CALL    HDG 


ACCUMULATE  STATISTICS 

N  «64 

DC   4011    J-1,37 
1FU.GE  -34JN-32 

IF    (INSPLS.GT.63.0)      CO    TO   4005 
MlNUl'SENSfltJ) 
R«X(J)-SENS(1«J) 
CONTINUE 
DO   4010    I=1,N 

ACUH1(J>«ACUN1(J)*SEKSIIBJJ 
ACUM2(J)-ACUM2(JI«(SENS(ltJMSENS  (l.JII 
lF(SFNS(]fJI.LT.HlNCJ!)MIN(JIs5ENS(I tJI 
lF<SEN5UtJ).GT.NAX(JllNAXUl=5ENS«I»Jl 
CONTINUE 
CONTINUE 
I RG  =A RG 

1FCINSPLS.E0.O.O)     IRG*0 
ACUN1(38)=ACUM1(38)*1RG 
ACUM2(38)<ACUM2(38)-»CIRG«IRG) 
IF(IRG.LT.MIN(38nMIN(38l  =  IRC 
1FI1RG.GT.MAXC381 )MAX(38 ) «1RG 
IF    (INSPL5.LT.63.0)         MIR (38)»MAX C38 1 
00   4020    1*1.4 
LAST1HCI J=CURTIMil) 
CONTINUE 
LASSEC*CURSEC 
1KSPLS=1NSPLS*64.0 
GO    TO    1000 

—NEW  EVENT  PROCESSING 


4010 
4011 


4020 


C 

c- 
c 

5000 


5010 


CALL  INTSUM 
IF  (EVENT. GT. 30) 
CALL  EVTERM 
CALL  EV1NIT 


STOP  5 


900  5 


POWER  FAILURE  CHECK 


IFUPWR.EQ.OIGG    TO    4000 
WR1TE(PRNTR1,9005*RECNOSCURTIM9LASTIK 
FORMAT (Til  ,15fT21BI393CeS9,l2»tT38»BP0yER 
3I3t3(a:*tI2!I 

NL1NES=NLINES*1 

TAPSUM  Listing    25    (5   of   6) 
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LEVEL   21  MAIN  0ATE  *  77148  12/59/15 

CALL  HDG 

6C  TD  *000 
C 

C— -1/0  ERROR  PROCESSING 

C 

7000   £ECND=REC^0-»1 

1FCTIERRS.GT.200)  STOP  7S00 

T1ERRS=TIERRS-»1 

*RlTE(PRNTRl,9007lRECa09LASTlH 

9007  F0RKATCT11, J5eT38fel/C    ERROR.    LAST   T  1NE-%13S3  t»S  «.  I2l! 
NLINES*MLINES«1 

CALL    HDG 

READ  (TAP1K89010S  DUK 

9010  FORMAT  JA1) 
(0  TO  1000 

c 

C- EOF /EOT  PROCESSING 

C 

8000   iF(ISF.EO.l)  60  TO  9998 

LSREC'RECNO 

CALL    1KTSUM 

CALL    EVTERM 

T0TSEC=TP8SEC 

CALL    TIHE{T0TSEC9PRNT1H! 

WRITE«PRhTRJ89008  JRECNC.PRNTIK 

9008  FCRMAT(T11,!5,T21,I3,3(BSB,I219T3899TAPE    TOTALS*! 
WR1  TECPRNTR1, 9009  HI  ERR S9TT  ERRS 

9009  F0RMAT(T11  B15,T36B*l/0    ERRORS 8/T 1 1 s 15  ,T38 B»T  IK E    ERRORS8! 

9998  PRINT    9011 

9011  FORMAT    UX,  "PROCE  SSIttG    COMPLETE,-! 
IFUFLE  -GE.NFLE  J    GO    TO    9999 
1FLE=!FLE*1 

GO    TO    1000C 

9999  STOP 
END 
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LEVEL      21  TIME  B/UE    *    ?fe341  13/91/13 

SUBROUTINE    TIKE     ISECS,    DHfcS) 
C 

C — -  —  COHPITES    TIME    IN    INTEGER    DAYS, 

C HOJRS,    HiSJJTES,     kHO    SECONDS,    FROM    RE&l    SECONDS 

C 

REAL*8    SECS 

REAL    DAYS,TE»tP,HRS,H!NS 

INTEGER    DWNSU) 

DAYS=5ECS/66^00.0 

DHH5(1)=LAYS 

TEMP=DHHM1 )»86400,0 

HRS=lSECS-TE*«M/3fe00.0 

DHM5(2l=HkS 

TEKP=TEHF*DHM SI  21*36  00.0 

M1NS=I5ECS-TEMP )/b0.0 

0HMS(3)=KINS 

TEMP=TEMP-»DHHS{  31*6  0.0 

SECS=SECS-TENP 

DHMSU) =SECS 

RE  T  URN 

END 


TIME   Listing   26 
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LEVFL       21 


HDG 


DATE 


763*1 


13/01/43 


SUB  ROUT  IKE    HDG 
C 

C PRINTS    TAPE    SUMMARY    AND    CDLUHN    HEADINGS 

C 

C COMMON     VARIABLES 

C 


9000 


9001 


COMMON 
1       TAPEN 
1       NL1NE 
1      LSREC 

KEAL»8 

1      LAISE 

REAL    TA 

INTEGER 

1       NAME{ 

IM  PtLIh 

WR  IT  EC  P 

FORMAT  ( 

l'TAPE    N 

KRITEJP 

FORM  AT  C 

2»C3HMEH 

PAGE=PA 

KLINE5= 

RETUKN 

END 


ACUM1,ACUH2, 
CSSENS,KIN.,K 

S.LASTIM.NAM 

A C UK H 38  J,  AC 
C 

PEKOm.SENS 
P*NT*2,DATE 
70) ,CURT IMC* 
ES.LT.55  )  RE 
RKTRi ,9000)P 
1H1  //T31, 
UMBER  e,2A4/ 
RhTRl, 9001  ) 
Til  ."RECLRD1 
T  »/T  11 »60( • - 
GF  +  1 
12 


CURSEC.mSECI&BSEC  .EVBSEC , TPBS EC ,1 ASS  EC , 

AXcINSPLS9PRNTR25DATEsEVENTelSF?RECM0s»*GEs 

EeCURTIM9EVINCTsINBT!MelHTCNTeEVBRECsPR»iTRl. 

UA2138),CURSEC,1NTSEC,1NBSEC .EVBSEC ,TPSS EC, 

164,37},  KIN  (38  J,  MAX  (38  ),  INSPLS 

.EVENT,  ISF.RECNO.P  AGE  (NL  IKE  S.LASTIsm, 

)rFVlNCT,INBT)M  U > , 1 NTCNT ,E V BREC .PRNTRl .LSREC 

TURN 

AGE, TAPENl.CATE 

s TAPE    SUMMARY  — stUS,*P4&E    SH/FU, 

T33, RECORDED    6,15///J 


,T25B»TIME,/T13,  »N0»,T22  ,*D       H 


S"fU5s 
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&    LEVEL      21  EVINIT  DATE    *    7b34I  S3/$l/fe3 

SUBKLUTJNE     EVINIT 
C 

C INITIALIZES    FDR    NEK    EVENT,    AID    PSIATS    BEGIN    EVENT    ENTRY 

r 

C~ COMMLN    VARIABLES 

C 

CCMKCN    AC,JMl,ACUK-2,CyRSEC,INT5EC,I*BSEC  .EVBSEC ,7FB5EC,LASSEC  , 
!       T  APENO.SENS,*  IN  ,  RAX  ,  INSPL  S,  PRNTR2  .DATE  ,EVE  NT ,  j SF, RECNQ,*AGE, 

1      KLmS»LASri<J,NAftE.CURT]nvEVlNCT,lNBT!H,!NTCaTv?MRE:.PtinKl  v 
3      LSREC 

REAl«8    A  CUM  1 138  J ,  ACUN2  ( 38  ) ,  ClRS  EC,  I  NT  SEC  ,  INBSEC  9EVBSEC  *TPBS  EC  * 
1      LASSEC 

REAL    rAPt*3(2),SE*S(64f3  7)fHlN(38)  ,HAU 38 J , INSPLS 

INTEGER    PRNTR2,  DATE, EVENT .lSF.RECNO, PAGE, NL  1NE  S  9lASTl*m  , 
I       NA*E(7C> ,CURTIH(4  J  ,E V  I  ACT • 1NB T IN  14  I , INTCNT ,E VBREC .PRNTR1 ,LSRE C 
C 

t- LOCAL    VARIABLES 

C 

REAL    SEIS, WIND, TYPE 

CAT*    SE IS/»SElS•/,WINC/•hlND,/ 

EV1NCT=0 

EVBRLC=RECND 

EYBSEC^CURSEC* 

EVEKT^EVENT-sl 

TYPE^HINU 

IFCSE^S  (1,29)  .ST.4.0  J    TYPE=SEIS 

MR!  TEC  PRNTR3  ;9000  IRECNO  ,  CUKT!M»EVEN  T,TYPC- 
9C00       FQRPATC  Til  ,li,T21  ,13  ,3  I8  S»,  !i  J,T38,  "BEGIN    EVEMT     •S!2*2X» 
5M'  ,A<»,  •)•) 

NL1NES=NLINES»1 

1FC1SF  .EU.OIRETURN 

DD    1C    1=1, 3e 

ACUM1U  1=0.  ODO 

ACJH2I1 1=0. ODO 

M1N  ( 1 )  =  0  .0 

MAX!  I)=0.0 
10  CONTINUE 

DO    20    I =1 ,4 

INBTIH  f  i  i=C JRTI M  il ) 
c\j  \.vn  i  muc 

IN&5  EC  =  C  UR  SEC 

TPB5EC=0.0D0 
ISF^O 
RETURN 
END 
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LEVEL       21  EVTERH  DATE    *    7h3M  13/01/43 
5UBRCUTINE    EVTERH 
TERMMAltS    E*E<U,    PRINTS    EMD    EVENT     ENTRY 


C0*KCN    VARIABLES 


COHHUX    ACUK],ACUR2»CU&SEC,1NTSEC,1NBSEC  ,EV  BSE  C  ,TP  BS  EC, I  ASS  EC , 
1       TAPEMJ,SENS»mw»HAX,iNSPLS,P!SNTS2,DMEBEVENt  ,  I SF, fcE CNQ ,» AGE , 
1       NL1NE  5tLA5Tl*BNAME9CURTIHffcVIwa,lhBTlR,INTCKT,EVBRee.P*NTRll 
1      LSREC 

RE k  1*8    ACUMlOSKACUKZOBltCURSECfllNTSEC.INBSECtEVBSE:  tTPBS  ECt 
1       LASSEC 

REAL    TAPEN0C2)*5ENS lfc4  e37 I t « IN i 38  J 9WAK C 38? , IfcSPLS 

INTEGER    PRNTR2, DAT E g EVENT s I Sf 5fiECNL5PAGE SHL IKES tLASTIHC^S, 
1       NAME  J  70),CyRT!K(4)  tEVItCT,lNBT!M  IMelNTCNTeEtfBREC.PRNTRl  rLSSEC 
C 

C LOCAL    VARIABLES 

C 

REAl«B     SECNDS 

INTEGER    EVRECS«PRNT1H(4) 

4fRi  TE?PR»NTRI,9000ILSREC9LAST1H,EVENT 

9000  FORPATf TI3 , I5.T21 »I3 »3 (  •  :", 12  J.T38,  'END    EVENT    9  ,12/T1 1 ,5{« -• ) , 
1T21  ,1?  (  '-'!> 

EV*4ECS=LS*EC-E/BREC*1 

SECND5=LASSEC-E  VBSEC 

TPB5EC  -TPBSEC+SECNDS 

CALL    TIMECSECNDStPRNTIM  1 

WRIT  EC  PRhTRl»9D01 )E VRtC S ,PRNT iM 

9001  FDRHATi 1 iii i SST 2i, i 3,3C s Ss ei2 i»T3a t SE¥ENT    TQT*LSS/J 
RL1 NES=nLINrS*^ 

RETURN 

END 
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LEVEL       21  IITSUK  DATE    =    76341  13/01/43 

SUBPDJT  1NE     I  WTSdM 

COMPUTES    FINAL    TINE     INTERVAL    STATISTICS 

AND    CUTPUTS    INTERVAL     SUMMARY 


■COIHOV    VARIABLES 


COMMON    ACUM.l,ACUM2,CURSEC,INTSEC,lNBSEC,EVBSEC,TPBSECsLaSSECB 
1       TAPENLtStNSBMlN,MAX,IN5PLStPBNTR«,DATE»FVERT9ISFBRECN0,PACE9 
1       NLlNES,LASIlM,NAHt,CURTIHtEVlHCT,INBT!Hf  IMTCJiT  &1  B*EC,Pl»Ttl  , 
1       LSREC 

REAL»6    AIUM1  138  I ,  AC  UM2  138 1 .  CUR  SEC  ,  I  NT  SEC  ,1KBSEC  ,EVBSEC ,T P9S EC , 
1      LASSEC 

REAL    TAPFNCm.SENS  J64  ,37  J,  M1N  C38  > ,  MAX  C  38  1,  INSPLS 

INTEGER    PRNTR2,  DATE , EVENT, I SF ,RECWO ,P AGE ,NL INE S ,LAST I  *U  U . 
1      NAME 170),CURT1HI4IBEV1NCT ,INBT1M  U 1 ,INTCNT ,EV BREC ,PRNTRI ,1 SREC 
C 

C LOCAL    VAklABLES 

C 

INTEGER    1,PRNT1HC4)  ,J,JJ 

REAl*8     VAR1 

DC    10    1=1,38 

1F(  J.E3  .3<.)JNSPLS=INSPLS/2.0 

IF  (1  .E&.38UNSPtS=INSPLS/32  .0 

ACUflC  I  1=ACUM1(I  J/1NSPLS 

VARI=ACUM2  tn/lNSPLS-|AClMHn«ACUP  HI)  ) 

lFCVAtl  .LE.O.O&0)    VARIM.OD-9 

ACUK2U  1=0  50RT(VARI  ) 
10  CONTINUE 

INTCNT=1NTCNT*1 

EVlNCr=EVI4Cm 

INTSEC=LASSEC-lNbSEC 

CALl     T1MEUNTSEC,PRNTIM  ) 

fcRlTE(PR«TR2,901Q?    T  APENC , I  WET  IK „£% ENT9 LAST IM,E VENT ,EVI NCT , 
2(PXNT)K(1)  ,1*2,*) 
9010       FORMAT! 1H1 , Til,  "TAPE    »0  .    e , 2A4 ,T55 , »5TART       SIS, 

33(»:,,12>/TllPeEVENT    NO.    %  12  ,T  55,  •  S1DP         e  ,13,  3C  eS  9  ,!  1\  /U  1  , 

4  'INTERVAL    SUMMARY     9  ,  1  2,  B-  •  ,11  ,1  55  ,  ■  DUR  AT  ION  8  ,  12,2  C a  :  8  ,12  )///  \ 
WRITE     IPRNTR?,901l) 

901)        FOR  M  AT  (T  11  ,  'SENSOR*  ,T22,  »M  I  N  I  MUM  •  ,T  3&  ,  9K  AX  I  WUH  8  eT52,88SE^B  JW  , 

5  »ST  L.  OE  V.»/T10,fe4  !•-•!/) 
DO    8020     J=l  ,13 

WRITE    JPRMTR2,9D1  2)     NAME  I  J)  ,MIN(  J)  ,SAX|J)  ,  AC  U*l  (J  1,  AC  J1 ?  i  J  ) 

9012  FORHAT  (T  13,  A^eT  12  9F8  .3  ,  T  36  BF8  .,3,150, 1  9.4  ,T64,P  8  .4) 
8020       CONTINUE 

hRITE    « PRNTR2  ,903 3  ! 

9013  FOlHAri/) 

DO    8040    JJ-1,3 
OC    8030    J=23,25,3 

WRITE     CPRNTR2,9012)     NAME  IJJ«J  ?  ,MIN  I  JJ*J  1  »MAX  i  JJ+J),  ACUM1  f  JJ  +  J)  , 
6ACJM24 JJ^Ji 
8030       CONTINUE 

WRITE     IP«NTR2,9013) 
8040       CONTINUE 

INTSUM  Listing    30    (1   of    2) 
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LEVEL   21  1WTSUM  DATF  *  763*1  13/01/43 

CO    8050     J=29,38 

feRlTE    (FRNTR2.9012)    HAME  IJ 1 ,F IK ( J  J ,KAX C J» »ACU«1 { J 1 , ACUK2 C J) 

IF  CJ  .E3  .32)»Ur  El»>&NTR2,9013) 

8050       CONTINUE 

WR1  TE(PRNTRl,90O0)LSRECBUSTlM,EVEWTtEVII4CT 
9000        FORHATfTU, ! 5,T21 , I  3 83 ( •  :  • , 12  J.T38, INTERVAL   SUMMARY    ,,r2,,-»,I2) 

NL INES  =  NLIBESM 

CALL    HDG 

INBSEC=CURSEC 

DO    2C    1=},* 

INBTHC  I  )=CURT1«U  J 
20  CONTINUE 

INSHS^O.O 

DO    3C    1=1,38 

ACUM1C 1 1=0 .ODD 

ACUM2JI  )=0.OD0 

KIN(l)-0.0 
30    MAX(I)=O.G 

RETURN 

END 
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SUBROUTINE  WINDOW 


INTRODUCTION 

This  subroutine  applies  split-cosine-bell  tapering  to  the 
input  time  series.   The  number  of  points  out  of  the  full  length 
(LENG2)  which  is  tapered  is  given  by  BBEG2  for  the  beginning 
taper  and  BEND2  for  the  ending  taper.   Both  of  these  parameters 
are  normally  set  up  in  the  calling  programs  for  10%,   The  height 
of  the  window  at  the  very  start  (ABEG)  and  end  (AEND)  are  also 
normally  set  up  for  10%. 

This  routine  also  has  the  capability  to  process  complex 
data  which  is  utilized  by  inputting  the  length  (LENG2)  as  a 
negative  value. 


See  Figure  60,  Table  16  and  Listing  31. 
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f     ENTRY    J 


CHECK  FOR 

ICOMPLEX  VALUES 

S  INITIALIZE 


CHECK 
FOR  PROPER 

ARGUMENTS 


COMPUTE 

FIRST 

RAMP 


TRANSFER 
CENTER 
VALUES 


COMPUTE 

ENDING 

RAMP 


(  \ 

I    RETURN    J 


Figure  60.   Program  WINDOW  Flow  Chart 
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Table  16.   WINDOW  Variable  Name  List 


Name 


Cora 


Type 


ABEG 

AMP 

AEND 

BBEG 

BBEG2 

BEND 
BEND2 

COEF 

COSNW 

COSP 

CPIB 

I  FLAG 

LAST 

LENG 

SIMP 

LFRST 

OFF 

PI 

SINNW 

SINP 

SPIB 

X 

Y 


R 

R 
R 
R 
R 

R 

R 

R 
R 

R 
R 
I 
I 
I 
R 
I 
R 
R 
R 
R 
R 
R 
R 


Dimension 


1 
1 
l 
1 
l 

1 
1 

1 

l 

l 

1 

1 

1 

1 

l 

1 

1 

l 

l 

1 

1 
passed 
passed 


Usage 


Height  of  window  at  X(l) 

Amplitude 

Height  of  window  at  end  of  data 

Length  of  taper  onset  if  complex 

Number  of  points  before  window 
reaches  max 

Length  of  tapering  off  if  complex 

Number  of  points  tapering  at  end 
of  data 

AMP  *  SINP  +  OFF 

COSP*CPTB  -  SINP*SPIB 

0.  or  COSNW 
Cos  (PI/BBEG2) 
Complex  data  flag 

End  of  a  window  section 
Length  of  data  if  complex 

1.  or  SINNW 

Start  of  a  window  section 

Offset 

3.141593 

SINP  *  CPIB  +  COSP  *  SPIB 

1.  or  SINNW 

Sin  (PI/BBEG2) 

Raw  data  input 

windowed  data  returned 
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LEVEL       21 


MAIN 


DATE    =    7SD21 


19/><»/3D 


VER5I3N    2       R3NALD    J»    REISER       2/9/73 

MODIFIED     TO    HANDLE    COMPLEX    DATft    ARRAYS.       IF    L E  N i  2    IS 
LESS    THAN    0    THEN    X    IS    ASSUMED    TO    BE    A    COMPLEX    ARRAY 
WITH    -LE^2    COMPLEX    EwEIESTS 


THIS    ROUTINE    WILL    FORM    A    COSINE    BELL    WINDOW    AROUND 

ELEMENTS     1     T3    LEN&2    OF    X    AND    STORE    THE    RESULTANTANT 
*<RAY     M    f.       THE    MEANlSi    OF     TrlE    FOJR    3THE<    ARGUMENTS    IS 
DESCRIBED    BELOW. 

ABEG-    HEIGHT    OF    WINDOW    \T    X(l) 

33EC2-NJM3ER    DF    POINTS     IETWEE*    BEGINNING    D  F     WI  SD3W     M)    ITS 
MAXIMUM    ONSET     OF     1 

9END2-NJM&ER    DF     POINTS     3ETWEEN    END    OF     MAXIMUM    ONSET     *ND 

THE    END    OF    THE    WINDOW 
AEND-HEISHT     3F     rflNDOrf    AU    X(LENS) 

THE    ftBDtfE    FOJR     VALJES    AlE    ASSJMED    TO    BE    FLOATING    P3HT 
4ND    ARE     CHECKED    PN     ENTRY    FOR    THE     FOLLOWING 

D.O       GE       BBEG2,BEND2 
93EG2*3END2       LE       LEN&2 
LENG2       GE       1 
D.O       GE       ABED       LE       1.0 
0.0       GE       AEND        LE       1.0 
Y     IS    ONl Y    AK3JMENT    RETURNED 

MANSFIH*    *Kf    BE    DONE     H    PLACE    I.E.    X    AMD    Y    M&Y     3E     5  \  ME 
ARRAY 


1 


AUTHOR    RONALD.   J    REINER    STA     11/6/72 

SU3R0JTINE    *lND:H(X,rfLENG2,\BEG,B3EG2,*END,BEYD2) 
DIMFNSION    X(1),Y{1) 
DATA    PI     /3-.1U593/ 

CHECK    F3<    CDMPLEX    X    AN)     SET     A^POORIATE    VALUES 

•  •  • 

LENG^LENG2 
BBE&^BBEG2 

bend=benl? 
iflago 

1fueng2.gt.d)   g  d   to  5 
leng^-2.0*lfng2 

BBEG=2.0*BBE&2 

BE*D=2.D*3EN)2 
IFLAG^2 
5  CONTINUE 

•  •  • 

...   CHECK  LEGALITY  OF  ARGUM  ENT  S 

•  •   • 

1FUENG.GE  .1  )     GD    T  J     10 
PRINT    1000, LENG 
ODD     FORMAT (1  hi  ,3DX, ?lHWlNrOW-LENi     ILLEGAL=  ,15) 

STDP     ID 
10     IFJBbEG.GE  .0.0. AND.  BEND.  GE  .  0.0. AND. 3B  E G  +  bE ND . LE .L E Y G  )     G D     TD     2D 
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LEVEL   21  WINDOW  DATE  =  76021  19/54/30 

PRINT  1 001 , B3ES, BEND 
10D1  FDRMAT(lHl,3DXt35HKlNDQW-EmER  BBE&  OR  BEND  ILLEGAL* 
1,2(010. <*,5X)) 
STOP  20 
20  IFUBES.  GE.  0.0.  ISO.  ft  BEG  -LE  .  1.01  SO  TO  30 
PRINT  1002,A3EG 

1002  F0RMAT(1H1,30X,21HWIND0W-ABES  I  L  L  E  &  A  L  =    ,G10.M 
STOP  30 

30  lFUENO.GE.O.O.ftNO.AEND.LE  .1.0)  SO  TO  40 
PRINT  1003, AENO 

1003  FORMAT  (  1H1  ,3DX,2H«IND0W-AEN)  ILLEGAL*    ,&10.<») 
STOP  40 

C 

C      ...   riRST  C  3  M »  J  T  E  Yd)  TO  Y  CBBES  ) 

C      ...   INITIALIZE  FOR  IN-LINE  SINE  C31PJTATIDN 

C 

40  lF(BBEG.LE.O.O)  &D  TO  55 

SPIB=S1N(C>1/BBE&2) 

CPIB^COS (PI/3BEG2) 

COSP=0.0 

SINP=-1  .0 

c 

C  ...       C  OMP JT  E     A^DLI r  UDE     ftNO    0  =  FSET 

AM»=(1.0-ABEG)/2.0 

DFF=(1.0*ABE&)/2.0 
C 
C  ...       NOW    COMPUTE 

LFRST=1 

LAST  =  33EL> 

DO    5U    J=LFRST,LAST,1FLAG 

COEF=AMP*SINP*QFF 

Y(J)=COEF*X( J) 

1FUFLA&.E2.2)    Y  (  J*  1  )=C  OE  F  *X  [  JM  ) 

SlNNW=SINP*CPIB+COSP*SPIb 

CDSNW=C0SP*CPIb-SINP*5PIB 

SINP=SINNrf 

COSP=C0SN4 
50  CONTI N JE 
C 

C  ...       COMPUTE    Y(BBEG-H)    TL    Y(LENG-BEND) 

C  ...       THIS    AHOJUS    TO    A    SIMPLE    TRANSFER 

55     1F(BBEG«BEND.GE.LENG)    GO    TO    i>5 

LAST=LENG-BENO 

LFRST=BBEG+1 

DO    60    J=LFRST,LAST 

Y(J)=<( J) 
60    CONTINUE 
C 

C  ...       COMPUTE    Y(LENG-BtND*l )    TO    Y(LENG) 

C  ...       SIMILAR    TO     CONSTRUCTION    OF    1(1)     TO    Y(BBEG) 

C  ...       IMILTIALllE 

65     IFtBEMD.LE.O.OJ    GO    TO    75 

SPIB=SIN(PI/BEND2) 

CPIB=C0S(P1/BEND2  ) 

WINDOW   Listing   31    (2   of    3) 
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LEVEL       21  WINDOW  DUE    '    7S021  1  9 / 5 <» / 3 0 

SINP=1.0 
COSPO.O 
ftM'Ml  .0-*EN3)/?.D 

OFF  =  (1.0*AEN;>)/2.3 
C 
C  ...         AT    ThIS    END,    BEGIN    WI^    SECOND    POINT    ON    CURVE 

C 

si  ^k  =  smi>*c>i3»::sp*spib 

C0SNW=:0SD*C?IB-SlNP*SPIb 

5INP=SINNW 

COSP=COSNW 
C 
C      ...   CJ^PJIE 

LAST=LENG 

LFRS7=LENG-BEND*1 

DD    70    J=LFRSI,LAST, I Fl  AG 

CDEF^MP^SIN'OFF 

Y( J  )=C3EF*X( J) 

if (  iflag.eq.2)  y ( j  +  1  )  < def *x ( j  + 1 ) 

sinnw=sinp*cpib+cosp*sp ib 
cosnw=:ds!>*::>i3-sisp«spib 

S1NP=S1 SN* 

cosp=cqsnw 

70  continue 

75  RETURN 
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PROGRAM  WNDSPC 

INTRODUCTION 

Program  WNDSPC  provides  power  spectra  of  wind  gusts  given 
approximately  ten  minutes  of  wind  data  from  U,  R,  W  directions 
of  up  to  five  different  sensor  locations. 

Each  run  using  the  full  five  channels  then  outputs  a  large 
Calcomp  plot  containing  18  spectra  with  their  associated  windowed 
time  traces  and  printer  spectra.   These  18  are  in  the  three 
columns  (U.  R.  W)  by  five  down  plus  an  average  spectrum  at  the 
bottom  of  each  column.   Optionally,  the  data  values  for  these 
three  average  spectra  are  also  output  on  punched  cards  to  pro- 
vide input  for  program  WNDPRM. 

For  Sitka  and  Newport  data  the  input  wind  data  is  by  a 
factor  of  four  from  a  sampling  rate  of  .07  second  to  .28  seconds. 
The  spectra  each  go  up  to  approximately  1.8  hz  (although  the  X 
axis  is  actually  wave  number) .   Each  spectra  is  smoothed  with  a 
19  pt.  running  average  to  provide  a  statistically  more  significant 
representation  of  the  underlying  stochastic  process  (probalistic 
distribution  of  wave  numbers  from  10  minutes  of  wind  gust  data) . 

See  Figures  61  through  68,  Table  17  and  Listings  32  through 
39. 

OPERATIONAL  NOTES 

To  produce  punched  card  output  of  the  three  average 
spectra,  set  request  parameter  NPUNCH  equal  to  1. 

Since  cards  for  all  three  average  spectra  are  all  run  to- 
gether without  printing  on  the  cards,  they  are  kept  separatable 
by  each  spectrum  ending  with  an  extra  card  containing  only  two 
values.   Since  these  values  are  beyond  the  1024  spectral  data 
points,  after  the  three  spectrum  decks  are  separated  and  labeled 
the  divider  cards  may  be  discarded. 
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Figure  61.   Program  WNDSPC  Setup  Title 


194 


0 


0 


(    START     J 


INITIALIZE 
CALIBRATION 


READ 

DATA 

REQUEST 


INITIALIZE 
INDICES 


SKIP  UP 
TO  DATA 


READ 
A 
RECORD 


INTERPOLATE 

IF 
NECESSARY 


DECIMATE 

&  FILL 

SAVE  ARRAYS 


CALCULATE 

FIRST  ANGLE 

CORRECTION 


_± 


SECOND 

ANGLE 

CORRECTION 


JL 


CALCULATE 
RESULTANT 
WIND 


I 


PRINT 

ANGLES  & 

/CORRECTIONS 


_ 


CALL 

INTPWW 
FOR  U,R,W 


STOP 

CLOSEOUT 

PLOTTER 
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Figure  63.   INTPWW  Flow  Chart 
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Figure  64.   SPCPWW  Flow  Chart 
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Wind  Spectra. 

201 


Table  17.   WNDSPC  Variable  Name  List 


Name 


A 

AXX 

AA1 

AA2 

ABEG 

ADD 

AEND 

AINC 

AMP 

AMP2 

ANGL 

ARG 

ATTACK 

AU 

AV 

AZERO 

BBEG 

BEGREC 

BEND 

BLANK 

BPEJR 

BPRR 

CCSIZE 

CHANO 

COMPN 

CONVRT 

CR 

DASH 

DATA1 

DATA2 

DATA  3 


Com j Type  \ Dimension 


Usage 


R 

R 
R 
R 

R 

R 

R 
R 
R 
R 

R 

R 

R 
R 

R 

R 

R 
I 
R 
I 
R 
R 
R 
I 
R 
R 
R 
I 
R 
R 
R 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
5 
3 
1 
1 
1 
21 
21 
21 


(2,h   Passed)]  Fourier  coefficients  array 
1030      Array  of  wave  numbers 

First  fourier  coefficient  of  a  pair 
2nd  fourier  coefficient  of  a  pair 
Window  height  at  start  of  data 
Arcane  variable 
Window  height  at  end  of  data 
Printer  increment 
|  Amplitude 
Current  amplitude  to  test  for  max 
Horizontal  wind  angle  V/U 
Argument 

Vertical  wind  angle 
Absolute  value  of  a  'U1  data  point 
Absolute  value  of  a  'V  data  point 
First  term  of  fourier  coefficient 
Fraction  of  window  to  taper  onset 
Beginning  record  of  request 
Fraction  of  window  to  taper  off 
Literal  blank 

Points  from  end  to  start  taper  off 
Number  of  points  in  to  end  taper  on 
Calcomp  plot  size  factor 
Wind  channels  to  process 
Wind  component 
MPH  to  M/S  factor 

Polynomial  correction  for  given  angle 
Literal  - 

Temporary  array  for  'U'  data 
Temporary  array  for  'V  data 
Temporary  array  for  'W'  data 
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Table  17.   WNDSPC  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


DT 

EM 

EYE 

FACTOR 

FREMAX 

FREQ 

HMEAN 

I 

II 

12 

IBUF 

ICH 

I  COL 

I  DATE 

IERR 

IFF 

II 

IM 

INDX 

INF 

INV 

IR 

IRF 

ISENSR 

ISENU 

ISENV 

ISENW 

I TAPE  ' 

J 

JP 

K 


X 

X 


X 


R 
R 

I 
R 
R 
R 
R 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 

I 

I 

I 
I 
I 
I 
I 
I 
I 
I 
I 


1 

1 
1 
1 
1 
1 
1 
1 
1 
1 
2000 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


Sampling  interval 

Log  (base2)  of  arg 

Literal  I 

Amplitude  conversion  factor 

Max  frequency 

An  individual  frequency 

Mean  velocity  of  horizontal  wind 

General  index 

General  index 

General  index 

Plot  buffer  storage 

Current  channel  being  processed 

Current  column  being  processed 

Date 

Error  return  flag 

Function  flag 

General  index 

NP+4 

Point  counter  within  PT  array 

First-call-to-routine  flag 

Work  array  for  RHARM 

Cosine  of  theta 

Read  status  flag 

Sensor  number 

Channel  number  of  'U'  data 

Channel  number  of  'V  data 

Channel  number  of  'W  data 

Tape  number 

General  Index 

Position  within  lyne  of  a  data  poirt 

General  index 
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Table  17.   WNDSPC  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


KOL 

L 

LASTPL 

LENG 

LL 

LYNE 

M 

N 

NAVE 

NCH 

NDEG 

NK 

NMIN 

NN 

NNP2 

NOREC 

NP 

NPTAVE 

NPUNCH 

NTH 

NUMI 

NUMLIN 

P 

PT 

R 

RADCON 

REC 

RECNO 

RSQ 

S 

SENSR 


X 

X 


I 
I 
I 
I 
I 
I 
I 
I 

I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 
I 

R 
R 
R 


I 
R 
R 


1 
1 

3 

1 
1 

73 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

1030 
3090 
2100 
1 

1 
1 

1 

1 
1 


No.  of  printer  plot  positions  across 

Data  point  counter 

Last  channel  flag 

Number  of  points 

Data  point  counter 

Line  array  for  printer  plot 

EM  Truncated 

Number  of  points 

NPTAVE 

Number  of  channels 

Demean/detrend  switch 

Original  data  points  used  per  record 

Number  of  minutes 

Number  of  freq  points  per  spectrum 

Number  of  freq  points  +2 

Number  of  records 

Number  of  points 

Number  of  points  to  average 

Card  punch  of  average  spectra  flag 

Print  every  nth  point  of  spectrum 

No.  of  pts  to  add  by  interpolation 

No.  of  lines  to  print 

Unsmoothed  spectral  points 

Data  for  the  3  average  spectra 

R  Component  wind  data 

Conversion  factor  degrees  to  radians 

Record  number 

Record  number 

Resultant  wind  squared 

Work  array  for  RHARM 

Sensor  number 
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Table  17.   WNDSPC  Variable  Name  List  (continued) 


Name 


Com 


Type 


Dimension 


Usage 


SAVEM 

SAVEV 

SENS 

SKALE 

STAR 

SUMAMP 

T2 

TANG 

TANGW 

TAPE 

TAPENO 

TAPR 

THETA 

THI 

TINC 

TINCM 

TLEN 

TMEAN 

TMEANT 

TSPAN 

TTIME 

U 

UAV 

UCOR 

UCOR2 

UCORD 

UCORF 

UFAC  *  r 

USUM 

V2 

VARI 


R 

R 

R 

R 

I 

R 

R 

R 

R 

R 

I 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 


1 

1 
64,43 

1 
1 
1 
1 
1 
1 
1 
2 
1 
1 
1 
1 
1 
1 
1 
3 
1 
1 
2100 
1 
1 
1 
1 
1 
1 
1 
1 
1 


Save  mean  value 

Save  variance  value 

1  record  of  raw  data 

Scaling  factor  for  time  trace  plot 

Literal  * 

Sum  of  amplitudes  within  a  spectrum 

TMEAN  in  meters/sec 

Tangent  of  horizontal  wind  angle 

Tangent  of  vertical  wind  angle 

Tape  number 

Tape  number  literal 

Fraction  tapered  at  each  end 

Horizontal  wind  angle 

Height  of  VSCAL  from  baseline 

Plotter  increment  for  time  trace 

Plotter  spacing  per  minute  of  data 

Length  of  time  trace 

Mean  velocity 

Mean  for  average  spectrum 

Time  spanned  by  time  trace 

TSPAN/ 2 

U  component  wind  data 

Average  ' U'  wind  velocity 

First  angle  correction  for  'U'  data 

Second  U  angle  correction  factor 

Second  U  angle  correction  adjusted 

Overall  'U'  angle  correction 

'U'  component  correction  factor 

Sum  of  'U'  values 

Variance  in  meters/sec 

Variance  of  wind  velocity 


J 
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Table  17.   WNDSPC  Variable  Name  List  (continued)' 


Name 


Com 


Type 


Dimension 


Usage 


VARIT 

VAR 

VCOR 

VCOR2 

VCORD 

VCORF 

VEL 

VFAC 

VSCAL 

VSUM 

W 

WAV 

WINC 

WLl 

WL2 

WL3 

WL4 

WORK 

WSUM 

WUl 

WU2 

WU3 

WU4 

X 

XLOC 

XLOK 
XT 
Y 
YLOC 

YLOK 


R 
R 
R 
R 
R 
R 
R 
R 

R 
R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 

R 
R 
R 
R 


3 

1 
1 
1 

1 
1 
1 
1 
1 
1 
2100 
1 
1 
1 
1 
1 
1 
passed 
1 
1 
1 
1 
1 
1 
1 

1 

1 
1 
1 


Variance  for  average  spectrum 

Average  'V  wind  velocity 

First  angle  correction  for  'V  data 

Second  V  angle  correction  factor 

Second  V  angle  correction  adjusted 

Overall  'V*  angle  correction 

Velocity 

'V'  component  correction  factor 

Vertical  scale  for  time  trace 

Sum  of  *V  values 

W  component  wind  data 

Average  'W'  wind  velocity 

Wave  number  increment 

Lower  limit  of  1st  wave  no.  step 

Lower  limit  of  2nd  wave  no.  step 

Lower  limit  of  3rd  wave  no.  step 

Lower  limit  of  4th  wave  no.  step 

Data  array 

Sum  of  'W'  values 

Upper  limit  of  1st  wave  no.  step 

Upper  limit  of  2nd  wave  no.  step 

Upper  limit  of  3rd  wave  no.  step 

Upper  limit  of  4th  wave  no.  step 

X  coordinate  for  plotter 

Horizontal  coordinate  of  current 
spectrum 

Horizontal  offset  from  plot  origin 

Counter  to  plot  minute  marks 

An  individual  scaled  trace  value 

Vertical  coordinate  for  current 
spectrum 

Vertical  offset  from  plot  origin 
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Table   17.      WNDSPC  Variable  Name   List    (continued) 


Name 


Com 


Type 


Dimension 


Usage 


YSAVE 
ZEROF 


R 
R 


Save  YLOC  value 
Frequency   increment 
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LEVEL      21  MAIN  DATE    *   77 17 1  16/28/26 


**«*•«*»*«  PROGRAM    HMOSPC    ISITKA    VERSION!  **♦♦••*•••• 

THIS    PROGRAM    INPUTS    APPRCX    10    MINUTES    OF    KIND    DATA    FROM    U,R,« 

DIRECTIONS    OF    UP    TO    5    OIFFERENT    SENSOR    LOCATIONS    USING 

ANGLE    CORRECTIONS    AND    DECIMATION    BY    A    FACTOR    OF    4. 

DATA    THEN    SETUP    FOR    TFE    PLOTTING    AfeD    POWER    SPECTRA    SUBROUTINES* 

ROUTINES    CALLED:    SITKA,    INTRPN ,    MA*GL,   UVCAL.    1NTPNW,    SPCPUH 

PROG.    BY    RAY    SOTOUDEH         5  .T  .A  .         12/12/72 
SCDIFIED    BY    DUANE    NELSON    DURING    1915    -   1977. 

COMMON/EXPARM/1TAPE9BEGRECBI!PTAVE  *NCH  ^JPUNCH 

CCMM0N/INPARH/COMPN{3leICOLB!CHeISENSRBTMEAN9HMEARBVARI 

DIMENSION    UC21001 ,W J 21  CO  J 9R J2 100  1 ,1BUF(20CO} 

DIMENSION    DATA1I21) tDATA2(21) -DATA3C21) 

REAL  SENS{64,43) 

INTEGER   CHAN0(5I,TAPEN0C2),RECND,BEGREC 

CALL    PLOTS    UBUF, 2000,6) 

CALL    NEWPEN    CI) 

CCS1ZE=.40 

CALL    FACTOR    (CCS1ZEJ 

DT=.28 

NPTAVE=19 
C 
C  READ    TAPE    NUMBER    CARD    AND    INITIALIZE    SENSOR    TABLE 

IFF  =  1 

CALL    SITKA    f IFF, RECNO, IRE. SENS, TAPEN0.1DATEJ 
C 

C  READ    DATA    REQUEST    CARD 

C 

READ    (5,65)    I  TAPE  .BEGREC  .NPUNCH  .NCH  ,  (  CH  ANO  (  Ij  -  1  =  1  ,5  ) 
85    FORMAT     (915) 

PRINT    95.IDATE.ITAPE.IEGREC 
95    FORMAT!///*    SITKA    WIND    SPECTRA    DATE*,  16,  ■    TAPE  =  %I6,»    8EGREC=«,I5) 
C 

DC    400     ICH=1,NCH 

K=0 

YL0C=(6-ICH)*11. 

ISEN5R=CHAN0(ICH) 

ISENU=fc*CHAN0(ICHl-5 

1SENV=ISENU«2 

ISENW=1SENU*4 

RECNO=BEGREC 
C 

C  REWIND    TAPE    AND    SKIP    UP    TO    DATA    TO    USE 

C 

IFF  =2 

IF    CICH.EQ.I)  IFF=3 

IF     (IFF.E0.2)  REWIND    10 

WNDSPC    Listing    32    (1    of    4) 
208 


LFVEL       21  MAIN  OATE    *    77171  18/28/28 

CALL    SITKA    (IFFfRECNO,lRF,SENS,TAPENO,lDATE I 

PRINT    165.ISE*SR,  I RF  ,  1SENU , 1SEN V , 15ENW 
185    FCRNAT     (^SKIPPING    DOWN    THE   TAPE    FCR    CHAN  •  .I3.3X,  «1RF«S  II  t  ■    ISENU 
l**,^.*    ISENV^.12,*    ISE*N=a.I2) 

DC    170    11*1.64 

DC  170  12 »1 .43 
170  SENSU1  ,12)=0. 

DC  175  1=1,21 

DATAKD-O. 

DATA2(1)=0. 
175  DATA3(IJ=0. 

SETUP    TO    READ    IN   9.3   N  IN   OF    CATA  DECIMATED   BY    FACTOR    OF   4. 
NORFC-128    FOR   NEW    SITKA.    120.5    FCR    OLD    (TO   6ET    2048    PT    SPECTRA) 
44    PTS/REC    •    .071    SFC/PT    *   4.544   SEC/rECorD 

NP«2048 

N0REC=NP/17«1 

IF  (IDA TE.GE. 75236)    N0IEC**P/16 

DO    250    J=l,NOREf 
1FFO 

IF    (I DA TE.GE .75236)         GO    TO    200 
CALL    SITKA    CIFF.RECN0.IRF.SENS.TAPEN0.1DATE) 
IF    (J.LE.l)         PRINT    185.IRF.RECN0 
185    FCRNAT    (•    IRF=»,l3t«    RECIC    NLW-a.!5) 

ADD    IN    MISSING    POINT    FOR   OLD   STYLE    DATA 
BY    EITHER   ADJACENT    REAL    DATA   OR    INTERPOL    1   POINT 
INITIALIZE    INTERPOL    IF    USED 

INTERP*! 

1NTERP*0 

IF    (INTERP.EQ.l)         GO    TO    190 

IF    (J.EQ.l)         GO    TO    210 

K«K*1 

U(K)r$ENS(2.ISENU) 

R(K)*SENS(2,ISENV) 

N(K)=SENSC2.ISENW) 

GC    TO    210 
190    DC    194    1=1.16 

DATAKI  )c$ENS(l*4.1SENU) 

DATA2CI  )-SENS(I*>4.1SENV) 
194   DATA3(I )«SENS (1 *4 .IS ENH  ) 

16    POINTS    GO    IN    AND    1NTERP    POINT    ADDED    AT    BEGINNING 

MUM1  =  1" 

NK=U 

1NF-1 

IF    (J.EQ.l)         1NF*0 

CALL    INTRPNCNUHl.DATAl.NK.INF ) 

CALL     1NTRPN(NUM1,DATA2,NK,INF) 

CALL    1NTRPN(NUM1.DATA3.NK.1NF > 

IF  (J.EQ.l)    GO  TO  210 

K  =K-»  1 

WNDSPC  Listing  32  (2  of  4) 

209 


21  RAIN  DATE    *    77171  18/26/26 

U(K)=DATA1C1) 
R(K)*DATA2(1) 
W(K}=DATA3tl) 
GC    TO    210 
200    CALL    SITKA     UFF ,RECNO , 1 * F .SEfcS .TAPENO .1  OAT E ) 
210    DC    220     1*1,16 
K*K*1 
C 
C  IF    ALL    DATA    POINTS    ICUIRED,    JUMP    OUT    OF    THIS    DATA    AC    LOOP 

IF    (K.GT.NP)         GO    TO    260 
C 

C  USE    K    ARRAY    FOR    V    UnTlL    CORR   HADE    AND    R    IS    CALCULATED 

C 

U(K)=S£SSC1«4,15EWU) 
tlK}sSENS(!*4,ISEievi 
«CK)  =  SENSU»*,ISENW) 
220    CONTINUE 
250    CONTINUE 
C 

260  CONTINUE 
C 

C  SUM, AVERAGE    VELOCITIES    AND    CALC    LA    ANGLE 

C  PLUS    AMPLITUDE    CORRECTIONS    USING    THAT     INDICATED    ANGLE 

CALL    WANGL     CU ,R , W  ,NP  ,ANGL »U AV  ,V AV  ,k AV  .ATTACK  ) 
CALL    UYCAL     IUA V , VAV, UCOR  ,VCOP  ) 
PRINT    285 ,UAVTV AY, ANGL, WAY, ATTACK  ,U COR, VCOR 
285    FORMAT     (•    UAV»'»F6.2«a    VAVSSF6.2,1    ANGL*  ", F6 .2 , •    WAV**,F6.2, 

!■    ATTACK  =  ",F6.2,"    UCOR =  ■  ,F5  .2 , •    VCCR  =  »,F5.2) 
DC    300    1*1, NP 
U(I  )=U(1  )*UCOR 
300    RC1 »=RII1*VC0R 

C 

C  SUM    AND    AVERAGE    CORRECTED    DATA    TC    SEE    IF    ANGLE    CHANGES 

C 

CALL    WANGL     CU ,R , W ,NP , AN GL  ,UAV ,V AV  ,W AV  ,ATT ACK 1 

CALL    UVCAL     CUAV , VAV , UCCR2  ,VCCR2 ) 
C 

C  NOW    RECORRECT    ANGLE    THEN    U    AND    V    AMPLITUDES 

C 

UC0RC=UC0R2/UC0R 

VC0RD=VC0R2/VC0R 

PRINT    305,ANGL,UC0RD,VC0RD 
305    FORMAT    !•    ANGL  *  ■ , F6 .2 ,  •    UCORC  =  • , F6 .2 , »    VCORD*  •  ,  F6  .2 ) 

DO    310    1=1, NP 

U(l )=U(I 1*UC0RD 
310  R(I )=R(I J*VCORD 

CALL    WANGL     (U  ,  R  ,W  ,NP  ,  ANGL  ,UAV  ,  VAV  ,W  AV  ,  ATT  ACK  ) 

NCW    CALC    H0RI2    RESULTANT    WINE.    AND    STORE    IT     IN    R    ARRAY 

320    DT    330     1=1, NP 

RSQ=U (1  |«UI I) «R( 1)cr ( 1 ) 

330    R(I  )=5QRT(RSQ)  tt  „,„*-, 
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LEVEL       21 


NAIfi 


DATE    «   77111 


18/28/28 


UCORF=UCOR*UCORD 
VCORF=VCOR«VCORD 

PRINT    3fc5,lSENSR.NP,BEGREC,«0REC,ATTACK,ANGL,L»CDtF,VC0RF 
365    FORMAT     (•0CHAN»,Ul»    REACY    FCR    IHTFMR    FOR9. 15. •    PTS    STARTING 


lCH0=•,K.2X,•li0REC  =  •t!<.t2Jt•ATTACK=•.F5.2,,    ANGL=',Ffc 
3F5.2,»    VCDRF=»,F5.2) 
FRINT    375, tUd)  ,1=1,70) 
375    FORMAT     (•    '.lOElLAJ 


AT    RE 
UCORF=", 


C 

c 
c. 

c 

c 


IC0L=1    FOR   U,    2   FOR    R,    3    FOR 
-KF I^V E  — HU*fr€*-ftF    PTS    TO    tC 


W       INDICATING  NHICF 
USCD    FOR    AVERAGING, 


COLUMN    OF    PLOT 
-H— MUST    PC    A 


-HtTf  Ct*  - — I-SKem-B   BE    USEP    FOR    HO   AVFRAEfNf, 


7 


1C0L=1 

IL0C=0. 

JF— C*C++^F-^1 G€-T«— 500 

CALL    INTPhfW    (XLDC  ,U  OC  ,  I  SENS*  ,U  ,NP  I 
1C0L=2 
XL0C=13. 

CALL    INTPWW    CXLOC,YLDC,ISENSR,R,NP) 
IC0L=3 
XL0C=26. 
HMEAN=TMEAN 

CALL    INTPWW    (XLOC,YLOC,ISENSR,b,NP) 
400    CONTINUE 


500    CALL    PL0T(0.0,0.0,999) 
STOP  99 

END 
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LEVEL       21  HA1N  DATE    «    7711.4  19/36/35 


©*«****»««  PROCRAH    KRDSPC    (NEWPORT    VERSION!  ••«***•*••» 


IMS    PROGRAM    INPUTS    APPRCX    1C    MNUTES    OF    MIND    DAT*    FROM    U,R,W 

DIRECTIONS    OF    UP    TO    5    DIFFERENT    SENSOR    LOCATIONS    LSING 

ANGLE    CORRECTIONS    AND    CECIMATICN    B1    A    FACTOR    OF    <.  . 

DATA    THEN    SETUP    FOR    THE    PLOTTING    AND    POWER    SPECTRA    SUBROUTINES 

ROUTINES    CALLED;    NEWPRT,    INTPPN,    WANOL,    UVCAL.    INTPWW,    SPCPWW 


PROG.    BY    RAY    SOTOUDEH  S.T.A.  12/12/72 

MODIFIED    BY    DUANE    NELSON    CURING    1915    -    1977. 


j:OMHUN/EXPARM/ITAPE,BE_&_REC,IILPTAVE_tNCli»N_PUNCH 

COMMON/ INPARM /COM PN(3) 1 1C0L,1CF  »  I  S~E  NSR  , TM  EAN  .HNE  A*  ,VAR  1 

DIMENSION    U (2100  J ,W C 2100  )  ,R (2 100 ) ,1BUF(2000) 

DIMENSION    DATA1121),DATA2(21) , CAT  A3 (211 

REAL     SENS(64,43) 

INTEGER  RECND,BEGREC,CHAN015) 

CALL  PLOTS  (1BUF,2000,6)  


CALL  NEWPEN  (1) 

CALL  FACTOR  (0.40) 

DT=.28 

NPTAVE=19 

NDEG=C 

J 

C        READ  TAPE  NUMBER  CARD  AND  IN  IT  1  AL  I  Z  E  SENSOR ""f  AB  LE 
C 

IFF=1 

CALL  NEWPRT  ( I F F , RECNC  ,  IR F  ,SE NS ,T AF END  .  ID  ATE  I 
C 
C      READ  DATA  REQUEST  CARC 


C 

READ  (5,85)  I T APE ,B E GR EC ,NPU* CF ,NCF , ( CH ANC t I) • I =1 .5 ) 
85  FORMAT  (915) 

PRINT  95, 1TAPE,BEGREC 
95  FORMAT  (///•  NEWPORT  WIND  SPECTRA  FROM  TAPE1, 16,  •  BEGREC=»,I5) 

C 

C 

C      INITIALIZE  INDICES  FOR  A  ROW  OF  3  SPECTRA  (U.R.W) 

C 

DC  ADO  lCH=lfNCH 

RECNL=D 

K=0 

YL0C=(6-ICH)»11. 

I5ENU=3MChANP(  1CH)-1)-»1 

1SENV  =  ISENU-»1 

ISENW  =  1  SENU-»2 

ISENSR=CHANO( ICH) 

RECNO=feEGREC 
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LEVEL   21  HAIN  DATE  =  77164  19/36/35 

C        REWINI  TAPE  AND  SKIP  UP  TC  D*TA  ID  USE 
C 

IFF=2 

IF  (1CH.EQ.1)    IFF  =  3 

IF  (IFF. EC.  2 1    REWIND  1C 

CALL  NEWPRT  t IFF , RtCNC » I RF .SENS ,T AFENC . ID AT  El 
PRINT  165.1SENSR, IRF , ISENU,ISENV, ISENW 
165  FGRKATd"  SKIPPING  DOWN  THE  TAPE  FCR  CHAN  %  13,  3X  ,  •  IRF  =  e  ,  1 1  •  •  1SENU 
$ 
01)   IEY013I  S>NTAX£«£e«*****«*eee««»sc«s±*93*de«3$s«»e$$»6««»»$83*««6$$9»«****eet« 

1=»,I2,'  ISENV=»,12,»  ISENW=»,12J  _         _ 

or  no  n=i,64 

DC  170  12=1,43 
170  SEN5( li  ,I2)=0. 

DP  175  .-1,21 

DATA1 ( 1 )=0. 

DATA2(  1)=0. 
175  DATA3CI J=0. 

SETUP  TD  READ  IN  9  e3  KIN  CF  CATA  DECIKATED  BY  F*CTDR  OF  4. 
Nl>REC=12E  FDK  SITKA,  12Ce5  FCR  NEWPORT  CFOR  2048  PT  SPECTRA! 
64  PTS/REC  *  -071  SEC/PT  =  4.544  SfcC/RECCRD 

NP=2C48 
N0REC=NP/17*1 
DC  25C  J=1,N0REC 
IFF  =3 

CALL  NEWPRT  { I FF , RE CNf  ,  I  R F  ,SE N5 ,7 AP EN  0  ,  ID «T E I 
IF  (J.LE.l)    PRINT  185,IRF,RFCKt 
165  FORMAT  (•  IRF=»,I3,»  RECNC  NCW=»,15) 

ADC  IN  HISSING  POINT  FCR  NEWPORT  DATA 
BY  EITHER  ADJACENT  REAL  DATA  OR  IN7FRPGL  1  POINT 
INITIALIZE  INTERPOL  IF  USED 

1  N  T  F  R  P  =  I 

INTERP=C 

IF  ClNTERP.EQ.l)    GO  TC  190 

IF  {J«EC.1J    GO  TO  21C 

K=K  +  1 

U(KI=SENS(2,ISENU J 

R  (K)  =  SEN5(2,1SENV) 

W(K)=SENS(2,1SENW  I 

GO  TO  210 
190  DC  194  1=1,16 

DATA1 (I  )  =  SENS(I*4,1SENU) 

DATA2(D=SENS(I«4,1SENV) 
194  DATA3CI  I =SE NS ( 1 *4 , i SEN W  } 
C 
C         16  POINTS  GO  IN  AND  1NTERP  POINT  ADDED  AT  BEGINNING 


C 


NUH1=1 
NK  =  16 
1NF=1 
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LEVEL   21  KA1N  _DATE^  771fc« 19/36/35 

(J. ECU  INF=U 


IF     (J.EC.l)  INF=U 

CALL    INTRPN(NUM1,DATA1,NK,INF ) 
CALL     INTRPN(NUMl .DATA? ,NK, INF > 
CALL     INTRPN(NUH1,DATA3,NK  ■  INF  ) 
IF     (J.EC.l)         6C    TO    2)0 
~K=K*1 


~*=K*1 
LKK  )=DATA1C1) 

R!K)=DATA2tl) 

K(K )=DATA3(1J 

210  DH  220  1  =  1, H 

K=K  +  1 


C        IF  ALL  DATA  POINTS  AGU1RFD.  JUMP  OUT  OF  THIS  DATA  AO  LOOP 

IF  (K.GT.NP)    GC  TO  260 
C 

C  USE    P    ARRAY    FOR    V    UKTIL    CORR    MADE    AND    R    IS    CALCULATED 

C 

-OTKT=SENSCl»<»rlSENU] 

R(K)  =  SENS(1*<*,ISENV) 

K(K)=5EN5(1*^,ISENW) 
220    CONTINUE 

IF     (J.GT.2)  CO    TO    25C 

PRINT    235, (U( I ) ,1=1, 2C) 

T>"R1NT    235, (R(  I)  ,1=1  ,2C  J 

PRINT    235, (W(  I)  ,1 =1,2C  ) 

FCRMAT     (•     S10E11.AI 


235    FCRMAT     (•     S10E11.A) 

250    CONTINUE 


26C    CONTINUE 
C 

C  SUM,AVERA&E    VE'-DClTlfcS    AND    CALC    li/V    AN&L  t 

C  PLUS    AMPLITUDE    CORRECTKNS    USING    THAT     IfcD  ICATFC    s&GLF 

C 

CALL    WANGL     (U  ,R  ,W  ,NP  ,  AK GL *U AV ,V A  V «fc> AV ,ATT ACK ) 

CALL    UVCAL     (U AV  ,V AV  ,UCOR  , VCDR )  

""PRINT    285,UAV,VAV,ANGl  , WAV, ATTACK  .ICDR.VCCR 
255    FCRMAT     {•    UAV=,,F6.2,f    VAV=»,F6.^,»    A NGL = • , F6 .2 , •    WAV=»,F6.2, 
I«    ATTACK=»,F6.2,»    UC OR  =  ■  9F 5  .2  ,  e    VCCR=»,F5.2l 
DC    300     1=1, NP 
U(1)=U(1)*UC0R 
300    R(l  I=R( 1 )«VCUR 
C 

C  SUM    AM    AVERAGE    CCkRECUD    LATA    TL     SEE     IF    ANGLE     CHANGES 

C 

CALL    WANGL     (U  ,R  ,W  ,NP  ,  AN G L  ,UAV ,V AV ,» A V ,ATT ACK i 
CALL    UVCAL     tUAV,VAV,UCCR2fVCLR2l 
C 

C  NT*     RECORRECT    ANGLE     THEN    U    AND    V    AMPLITUDES 

C 

UC0PD=UCUR2/UCU? 
VCDRC*VCUR2/VCDIi 
PRINT    305  ,ANGL .UCORC iVCOPC 
3C5    FCRKAT     {•    AN&L  =  • ,  Ft .  2  .  •    L CLRL  =  •  ,F 6  .2  ,  •    VCCR D= • , Ffc  .2  J 
DC    310     1=1 ,NP 
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LEY  EL  _  21  RAIN    OAT  E  «  7716 4 19/36/35 

U(i}=Ui I )*UCORD 
310  RU )=RU)*VCORD 

CALL    WANGL     (U ,R ,W ,NP , AN GL ,UAV ,VAV ,ti AV .ATTACK  1 
C 

_C NOW    CALC    HDRIZ    RESULTANT    WIND    AND  _JTPR  £  J T_Jfc    R_£fj?AY 

C 

320    DC    330     1=1, NP 

RSQ=U(I  )*U(I)+RCI  )*R(1) 

330    R(I)*SQRTCRSQ) 

r 

UCORF=UCLR«UCORD 

urnD[.urnD<vrhcn 


£  !CDL  =  1    FOR    U,    2    FOR    R,    3    FLR    W       INDICATING    HH1CJ-    COLUMN    OF    PLOT 

r 

!CDL=1 
XLOC=0. 


CALL     INTPWW    (XL0C9YL0Cs!SENSR  SUBNPJ 

IC0L=2 

XLDC=13. 

IF     UCH.GE.2)  GO    TO     50C  **-  rW  W-y 

CALL     INTPWW    (XLOC,YLOC,!SENSR,R,NP> 

IC0L=3 


XL0C=26. 

H*EAN=THEAN 

CALL     INTPW*    CXLOC,YLOC,!SENSR,*,fcPJ 
*»00    CONTINUE 
C 

500    CALL    PLDTCO.0,0.0,999  } 
STOP  99 

END 
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LEVEL       21  MAIN  DATE    *   77171  13/28/28 

SUBROUTINE       !    N    T    P    W    N 

THIS    INTERMEDIATE    ROUTINE    PLOTS    WIND    AND    SETS    UP    WIND    SPECTRUM. 
ROUTINES    CALLED    ARE:    CETRAD,    WINDOfe,    RHARM,    SPCPNk 

PARAMETERS 

XLOC.YLOC-    STARTING    LCCATION    FOR    THE    PLOT    ON    PAPER 

ISENS/fR-   SENSOR    «5*£==Sfc  NUMBER 

WORK-    WORK    ARRAY.    THIS    ARRAY    MUST    BE    DIMENSIONED      10   LOCATIONS 

LARGER    THAN    LENG 

LENG-    «    OF    DATA    PNTS.    TO   BE   USED.      MUST    BE    6E    8    AND    LE   4096 

NOTE:    If    LENG    GT    4096    ,    CHANG    THE    DIMENSION    OF    »V    C    S    IN    THIS 

PROGRAM    TO    1/6    OF    LENG 

PROG.    BY      RAY    SOTOUDEF         S  .T .A .      3/7/74 
MODIFIED    BY    DUANE    NELSON    S.T.A.       1975*1976 

SUBROUTINE    INTPWW     (XLOC  » YLOCs  ISENSR  *W0RK  tL  ENGS 

COMMON/EXPARM/ITAPEbBEGRECjNPTAYE  SRCH,N PUNCH 

COMMUN/1NPARM/COMPNC3!SICOL  9I  Oi  sl$ INS eTME AN .HMEAN ,V ARI 

DIMENSION    WORK (II 

DIMENSION    1NV(512),S(512) 

INTEGER    BEGREC 

DATA    ABEG,AEND,BBEG.BEND/.10,.10,.10t.10/ 

TAPR=BBEG 

NP=LENG 

DT=.07 

CCS12E-.40 
C  M  =  10     (1024)       FOR    10   MINUTE    SPECTRA       11**2052    AFTER   DECIMATION) 

ARG=NP/2 

EM-(ALOGIOCARG) 1/ ( ALOG 10 (2. ) 1  « .1 

PRINT    165VNP,EM>LSENS,C0MPN(1C(JLS 
165    FORMAT    (///'    WP=s,i5,s    EB-a»F4.1va    FOR    CHAN s , 13 ,A 1 , •   WIND    DATA") 

M  =  EM 

lM  =  2»C2«*M)*4.<i9 
C 

C  REMOVE    LINEAR    TREND    AND    CALCULATE    MEAN    AND    VARIANCE 

C 

NCEG=1 

PRIM     195,NDEG 
195    FORMAT    *•    READY    FOR    OETRR  D»NDE6*  •  »!  2  »  12X  -.  'TMEAN  9V  AR  I    IN    MPH  •) 

CALL    DTRND2    ( WORK (1 ) .NP «NDEG.TKEAN ,V ARI  ) 

SAVEM=TMEAN 

SAYEV=VA'RI 
C 

C      WINDOW  THE  DATA  ARRAY 

C        READJUST  AMPLITUDE  FOR  LOSS  TO  WINDOW  FUNCTION 
C 

BPRR=BBEG«NP*.5 

BPER=BEND»NP-».5 

CALL  WINDOW  (WORK .WORK  ,NP  ,ABEG ,BP RR , A  END, BPER ) 

FACTOR*!. /(l.-TAPR) 
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LEVEL       21  INTPWW  DATE    *    77111  18/28/28 

DO    300    1=1, NP 
300    WORK (I ) =WDRK( [)«FACTOF 

CALL    DTRND2    ( WORK ( 1 J ,RP , RCEC ,TPEAR , VAR1) 

TMEAN=SAVEH 
C  VAR1=SAVEV 

C 

C  CONVERT    ^IME    DATA    FRGK    HPH    TC    H/S    AND    PRINTOUT    THE    TIME    TRACE. 

C 

C0NVRT=.4*7 

DC    3C2    1  =  1, NP 

302  W0RK(I)=W0RK(1  )»C0NVR7 

303  CONTINUE 
PRINT    3C5 

305    FORMAT    (•     THE    FOLLOWING    DATA    IS    THE    DECIMATED    TIME    TRACE    IN   METERS 
X/SEC    AFTER    WINDOWING    AND    READY    FOR    FOURIER    TRANSFORMING »/J 

NUML1N=NP/10*1 

L  =  l 

DO    310    K=1,NUHL1N 

LL=L-»9 

PRINT  315,  |WORK(I  1 , 1 =L ,LL  ) 
310  L=L+10 

315  FORMAT  (  •  ,,10F10.4) 
C 

C  DRAW    FRAKE    AROUND    TIME    TRACE    AND    PLOT    THE   MINUTE    $&RK5S 

C 

XL0K=XL0C+0.5 

TL0K=YL0C+8.5 

CALL    PLOT     (XLOK.tLOK  ,-3) 

TINC=.002/CCSIZE    •    2048/LENG    «DT /  .07 

TINCH=TINC*64.*13.2 

TLEN=T1NC«NP 

THI=.25/CCS1IE 

CALL  PLOT  «TLENt0.,«21 

CALL  PLOT  (0.,0.,«2) 

CALL  PLOT  C0.,TH1,*2) 

CALL  PLOT  (TLEN.THI 9*2) 

CALL  PLOT  tO.,0.,*3) 

CALL  PLOT  (0.t-THl««2! 

CALL  PLOT  tTLEN,-THI,i2) 

CALL  PLOT  C0.,0.,*3) 

XT=0. 

NM1N=9 

DO  330  I=1,NM1N 

XT=XT«TINCM 
330  CALL  SYMBOL  (XT  ,-TH  I  ,  .14  ,13  ,£  .,-1  1 

CALL  PLOT  C0„,0.,*3J 

ADD  VERTICAL  AXIS  SCALE  VALUES  AND  SCALE  THE  DATA  ACCORDINGLY. 

SCALE  5  M/S  (11.2MPF)  >  .25  INCH  AFTER  REDUCTION. 
THEN  PLOT  CONDITIONED  TIME  SERIES  CSTA  IN  M/S  FROP  MEAN  MIHD 

CALL  SYMBOL  ( -. 38 TH I »„ 14 . .14, 1H5 ,0 . ,1 1 
CALL  SYMBOL  l-.3,TH 1  ,  .14  ,2H«5 ,G . ,2  I 
CALL  SYMBOL  ( -.3,- .07,  .14  ,1HG  ,C  .  ,  1 ) 
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LEVEL       21  1NTPWW  DATE    *    77111  18/28/26 

CALL    SYMBOL    (-.3,-TH 1  ,  .14 ,1H5 ,0 ., 1 ) 

CALL    PLOT     (0.t0..«3) 

YSCAL=5. 

SKALE=THI/VSCAL 

X=Oc 

DC    350    1=1, NP 

X=X*TINC 

Y  =  WORK(n«SKALE 

CALL    PLOT     (X,V,*2) 
350    CCNTJNUE 
C 
C  RESTORE    ORIGINAL    ORIGIN 

CALL    PLOT     t-XL0K,-YL0K,-3! 
500    CONTINUE 
C 

C  COMPUTE    FOURIER    COEF.    THEN   CALL    TO   PLOT    REDUCED   M IND   SPECTRUM. 

C 

CALL    RHARH     fWORK  1 1 )  ,M  ,  IN V  ,S  ,1  ERR  ) 

IF     (IERR.NE.OI         PRINT    555.IERR 
555    FCRMAT    C1H1  ,20H INTPWR --RF ARM    IERR=  »I2I 

CALL    SPCPWW    (XL0C,YL0C,W0RK(1),IM) 

RETURN 

END 
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LEVEL   21 WAIN DATE  '  77U4 19/36/35 

SUBROUTINE   S  P  C  P  W  W 


THIS  PRCC.  COMPUTES  AND  PLOTS  POWER  AND  REDUCED  SPECTRUf 
RCUTINES  CALLED:  NONE 


PARAMETERS 

XLOC.YLDO  STARTING  LCCATION  ON  PAPER 
A-  DATA  ARRAY  AS  RETURNED  BY  'REARM" 

CONTAINING  N/2-2  UNICUE  COMPLEX  POINTS 
FfR  1C  WIN  SPEC  KITE  DT=.2£SEC,  *=2052    SO  NN  =  1024 , NNP2*1026 


PROG.  BY  RAY  SOTOUDEH    5  .T  .A  .     3/1/1** 

MODIFIED  BY  DUANE  NELSON  DURING  1915-1977 


SUBROUTINE  SPCPWW  CXLOC  ,YLOC, A,N I 
^CMMUN/EXPARM/ITAPE.BEGREC.IiPTAyE  ,»CH,N  PUNCH 
COMMON/INPARM/COMPNO)  ,ICOL  ,  1CH .LSENS  .TME AN  ,HM EAN  ,VAR1 
DIMENSION  A(2,1),LYNE(73J,PC]020),*XX(103CJ,S(103CS 
DIMENSION  PT(3090),TMEANT(3),VAR1T(3I .LASTPLC3) 
INTEGER  L YNE, BL ANK, E YE  ,  DASH, STAR,  JF 
INTEGER  EEGREC 

ALPHANUMERIC  DATA  STORED  LEFT  JUSTIFIED 


DATA  BLANK, EYE, DASH, STARrKQL/lh  ,  1H  ,  1H-,  1H  *  e73/ 

INITIALIZE  PROGRAM 

SET  1NLEX  FOR  COLUMN  (U.W.CR  RJ 
SAVE  YLOC  TO  GET  FROM  AVE  PLCT  TL  5TH  CHAN  YLDC  FCR  NEXT  COLI 


DT=.28 

1NDX  =  UC0L-1)*1030 

YSAYE=YLLC 

IF  UCH.GT.l-OR.lCOL.CT.il    GL  TO  20 

DC  3  1-1,1030 
3  SCI  1=0, 

DT  4  ~1  =  1730  90 
<i  PT(1I=0. 

DC  5  1=1,3 

TMEANT(1)=0. 

VARITCI J=0. 
5  LASTPL(I)=0 

NNP2=N/2 
20    CONTINUE 

AZERC=AM,1  ) 

T2=TMEAN*.447 

V2=VARl*.«47*.*47 
3C  NN=N/2-2 
C        2ER0F=. 001744  FOR  DT=.28  1C  MINUTE  SPECTRA 

2ERCF=l.C/(fN-4}*DT) 

FREMAX=NN»ZEROF 

T5PAN=(N-4)*DT 

!TlME=TSPAN/2. 
C 
C    """  VEL    AND    T2    BOTH    ARE    MEAN    WIND    SPEED    IN    METERS/SEC 
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LEVFL   21  SPCPhk  DATE  *  77H<  19/36/35 


C         BUT  VEL  IS  USED  ONIY  FOR  bAVE  NLMBER  CALC 
C 

VEL=T2 

IF  CVEL.LT.O.I    VEL--VEL 

IF  (1CUL.IT.3)    GC  TC  70 


C 

c 
c 


C      SPECIAL  SET-UP  FDR  VERTICAL  SPECTRA  USES  HORIZONTAL  WEAN  VELOCITY 
C         WhCSF.  VALUE  HAS  LOADED  INTO  HMEAK  IN  MAIN  DRIVER  PROGRAM 

VEL=F:MEAK*.447 

IF  (1CH.EQ.NCH)    VEL=5AVERV«.<»<i7 

IT  "TVEL.lT.O.l   ~TEL=-VEL 
70  CONTINUE 
C 

C      SET  UP  PSEUDD-LO&  SPACING  OF  PRINTER-PLOT  SPECTRUM 
X 

WINC=ZERCF/VEL 

fcTl  =  .O05 

NU1=WL1*W  INC 

YL2=.010 

hU2=WL2«WINC 

NL3=.O20 

WL3=WL3-»WINC 


HL<»=.050 

HLA=HLA+kINC 

IF  C1C01.EC.3)    PRINT  74.VEL.KINC 
7*.  FCRMAT  (•  VERT  CHAN  VEL  =  ,,F7.3ti  W  INC  =  •  .F  ">  .4  ) 

PRINT  75,N,DT,VEL,T2,VARI 
75  FrRfAT(»  N=•,IA,•  DTs'tFT.*,*  VEL*atF7.3v*  12'*,ft.39'    VAR1-', 

TT8.3) 

C 

C  FIND    MAX    AMPLITUDF    AND    SUP    OF    RAW    F.S.D.    (BEFORE    REDUCING    UNITS) 

C  BUT    MANUALLY    SET    HAXAPP    TC     .5    IF    CCNSTANT    SCALING    FOR    ALL    SPECTRA 

C 

AHPMAU  ,2)«A(1,2  )+A  (2  ,2  )*A  (2  ,2  )>  «TT  IME  

5TJHAKP  =  AKP 

AHP=AHP»2ER0F/V2 

DC    100     1=3, NN 

AMP2=(A(1,1)*A(1,I  )-»A(2,  IJ*A(2,I)     )«TTIKE 

5UMAMPsSUMAMP*AHP2 

1F( 1SPCTP.EQ.1 )       AMP2=AMF2*tl-l)«ZERCF/V2 
"1FIAHP2  .GT.AMP J       AMP=ANP2 
100    CONTINUE 

A*P=.5 

AINC=(K0L-1)/AMP 
C 

C      COMPUTE-SPEC.  AND  PHASE 
C 

DP  3C0  1=1, NN 

FREC=I«ZERCF 

AA1=A(1  ,1*1 ) 

AA2=A<2  ,1*1 ) 

IF     (AA1  .EQ.O.O)  AA1  =  .001 

IF     (AA2.EG.0.0)  AA2=.0ll 
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LEVEL       21  SPCPWW  DATE    =    77164 19/36/35 

A(l  ,  I)  =  (AA1*AA1+AA2«AA2}*TTIME 

A(1,1)=A(1,I)*FREQ/V2 

A (2 ,  1)=ATAN2(AA1,AA2  >*5  7.295fc 
270    P(1)=A(1VI) 

C      

C        ALSO  ACCUMULATE  FOR  AVERAGE  SPECTRA 
C 

PT{ MINCX)=PT (I-»INDXMP(I> 
300  CONTINUE 

TMEAKTdCOL  )=TM EANT (  1CCL MTMl AK 

VAR  IT(  1CLL)=VARIT(IC0L)-»VAR1 


350  CONTINUE 
C 

C  CALL     SMOOTHING    ROUTINE     FOR    UNSMOCTHED    DATA    ARRAt    P    OF    HH    POINTS 

C  S    IS    THE    SMOOTHED    OUTPUT    AVERACED    OVER    NPTAVE    PTS    fUSUALLV=19) 

C 


NTH  =  1 

IF  (TSPAN.GT.500.  J    NTH=NTH*2 
IF  (TSPAK.GT.lUOC  .)   KTH=*TH*2 
CALL  AVERG2(P,NN,NPTAVE  ,5) 
C 

C PRINT  SPECTRUM  HEADING 

C 

DC    400     1=1  ,KUL 
LYNE( 1) =DASH 
400    CCNT1NUE 

LYNE(1)=EYE 
LYNE (KCL )=EYE 

PRINT    A05,LSENS,CnMPNCICCL  1  ,T SPAN ,E E ORE C  .NPTAV E  , AMP  ,LYN E 
405    FCRMATdHl, 'CHANNEL  », 13, M     .«    F0RsfF7.1,»    SEC    H1NC    SAMPLE    STARTING 
.1    REC«,J5,20X,  12, •    PT    AVE    POWER    SP  EC  TRUM  •  ,  /  ,  27X  ,  »P  .S  .•  ,6X  ,  »FREO  B  , 
25X,iW.N.9,5X,80B,66XtF7.3,/5SXf73Al ) 
DO    420     1  =  1, KUL 
420    LYNE  (IMELANK 


IF     (VEL.LT.10.)  NTH=NTh/2 

IF     CVEL.LT.5.C.ANDcNTF  .GE  .2)         NTH=NTH/2 

DO    500     1=1, NN 

FRE0=I«2ER0F 

IF     (5(1  l.LE.O.G)  5(H=C.00C01 

IF     (SU).GT..4U)  SC1)=C.4C 

~AXX(1  )=FPEQ/VEL 

lF(AXXd).LT.O.O)  AXXd  J  =0.00001 

C 

C  ONLY    PRKNT    EVERY       NTH       POINT    OF    SMOOTHED  LI 

C 


LYNEU  J^EYE 
LYNECKCL J =EYE 
JP=AINC*S( 1 1*1*4999 


NTI^=NTH*2 
NTh=NTH*2 
NTh=NTH*2 
NTH=NTH*2 
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LEVEL       21 SPCPhh DATE    =   77164 19/36/35 

IF     (JP.GT.72)  JP=72 

LYNE( JP  )=STAR 

PRIM  485,I,S(I),FREe,AXX(I),LYNL 
485  FORMAT  (•  • , 14 , 18X 9 F 9 s5  ,2X  ,2F9 .5 ,31 .73A1 1 

LYNE ( JP ) =8LANK 

500  CONTINUE 

PRUT    515,AZERD,SUMAMF,TPEAN,VEL,V*R1 
515    FCRMAT     {  »OAZE  RG  =  ■  ,F9  .4  ,  »    SUMAMP  =  •  ,F  9  .2  ,5X  ,  •    THE  AN = • ,F6 .2 , 
X»    HPti*ttF6.2aa    M/S  VAR  I  =  »  ,F7.3, •    MPH») 

IF  (XLLC.LT.O.)    XLOC=0. 

PRINT  535,  (5(11,1=1,5) 

535  FORMAT  (•  FIRST  5  DATA  VALUES  FOR  CALCUMP  PLOT :«  .5F10.3) 

SET  SCALE  FACTORS  (FIRST  VALUE,  DELTAV)  FOR  CONSTANT  PLOT  SIZE 
SCALE  ACROSS=  12  !NO=  4  DECADES   SO  1  INCH  =  .3323  DECADES 
8  INCHES  HIGH  (FULL  SCALE)  =  .40,  SO  1  INCH  =  .C50  DECADES 


S(NN+1 ) =0.0 

S(NN+2)=.050 

AXX(NN*1)=.0001 

AXX (NN+2)=.3333 
600  CCNTINUE 
C 

C      PLOT  MEAN, VARI .TAPE, RECORD  AKD  SENSOR  1NFCRHATICN 
C 

CALL  5YM60L  (XL0C*9.7,YLCC*7.6, .14.11HMPH      H/S. 0.0,11) 

CALL  SYHEPL  (  XL  DC  *B  .4  ,  YLC C  +  7.2  ,  .2  1 ,  5HME  AN  =  ,0  .  ,5  ) 

CALL  NUMBER  ( XL OC *9 . 5 , Y LC C  +  7 . 2 , .2 1 , TK FA N  ,  C  .  ,2  ) 

CALL  NUMBER  (  XLOC  *1  C  .1 ,  YLCC-»7  .2  ,  .  21  ,T2  ,0  .  ,2  ) 

CALL  SYMBOL  ( X LOC  +  8  .4  , Y L C C*6 . 8 , .2 1 , 5H VA R I = ,0 . , 5 ) 

CALL  NUMBER  ( XL DC  +  9 . 5  ,YL L C*6 .8 , .2  I , VA R 1  ,0  .  ,2 ) 

CALL  NUMBER  ( XL OC ♦lC .1 ,YL C C  +  t .8 , . 21 ,V2  ,0  .  ,2  ) 

CALL  SYMBOL  ( XLDC ,YL UC-0 .8 , .2 1 ,5HTAPE  =  .0  .0  ,5 ) 

TAPE=ITAPE 
CALL  _NUMbER  ( 999.0 ,999 .0 , .2 1, TAPE ,C. *-l )        

CALL'  SYM10L{999.,999.,.21,8H  SENSOS=,0.  ,8  ) 

SENSR=L5ENS 

IF  (LASTPL(lCOL).EU.l)    CL  10  620 

CALL    NUMBER (999 -.999., .2  1  ,S  EK  5R  ,0  .  , -1  ) 

OC    TO    6  22 
620    CALL    SYMtCL     (  999  .  ,99  9  .  ,  .2  1  ,  3B  A  V  E  ,  0  .  ,3  ) 
622    CALL     SYMBOL    ( 999 . ,999  .  ,  .2 1  ,CC MPN ( IC OL  )  , 0.  ,  1  ) 

CALL     SYMBOL     ( 999 . 0  ,995  .0  ,  .2 1 , 10H  REC    *=     ,0.0,10) 

REC=BEGREC 

CALL    NUME  E-R  (999  .0  ,999  .0  ,  .2 1,1- EC  ,C.,-1  I 
C 

C  PLOT    AXIS,, FOR    SPECT. 

C 

CALL    AXIS     (XLOC.YLUl  .UNREDUCED    S  PE  C  TRUM  ,  16  ,8  .0  ,9  C  .0  ,5  (  NN*  1  )  , 
/S(NN*2)) 

CALL    LGAX5(XL0C,YLLC,"JBWAVt    KD,-7        ,  1  2  .  0  ,C  .0  ,  AX  X  UN*  1 )  ,  AXX  t  NN*2  !  ) 
€40    CALL     PLCT(XL0C,YLnC,-3) 

CALL     LGL  IN(AXXd)  ,S(  1)  ,NK  ,1  ,0  ,C  ,  =  1  ) 

CALL    LGL  IK  (A XX ( 1 )  ,  S (  1  )  ,NN  ,1  . 0,0,-1) 
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LEVEL   21 


SPCPtaW 


CATE  -  77U4 


PRINT  642 
642  FORMAT  (•  SPECTRUM  PLCTTED  -  RESTORING  ORIGINAL  PLOT  ORIGIN') 
690  CALL  PLOT  (-XLDC , -YLOC ,-3 J 

IF  UCH.LT.NCH.OR-LASTPL  (ICOL).GE.l  J    GO  TO  90u 


CALCULATE  THE  AVERACE  SPECTRA  FRCM  ACCUMULATED  TOTAL 

Dr  750  I=1,NNP2 
750  P(I  )=PT{  MINDXJ/NCH 
LASTPLt ICnL 1=1 


SAVE  LAST  INDIV  R  MEAN  VEL  PER  LAST  INDIV  M  CALC 

IF  IIC0L.EQ.2)    SAVERV=TNEAN 
TMEAN=THEANT(ICOL 1/NCF 
VAR1=VAR1T(1CDLI/NCH 
T2=THEAN«.447 


USE  NEW  AVE  VEL  FOR  WAVE  NLHEFR  CALC  EXCEPT  IF  VERTICAL 

THEN  LEAVE  DLD  VALUE  FROM  AVE  R 


VEL=T2 

IF    (IC0L.EQ.3) 


VEL=KME*N*.<i<n 


V2=VARl*.447*.447 

PRINT    755,    NCH 
755    FORMAT     (•    FINISHING    SPECTRA    -    AVERAGE    OF', 131 

YLOC*0. 

GC  TC  350 
900  YLOC=YSAVE 


PUNCH  OUT  CARDS  OF  AVERAGE  SFECTPA  DATA 

IF    CNPUNCH.EQ.O)         GO    TO    990 

IF     (LASTPLtlCDD.LT.l.CR  .1CH.LT.NCU         GO    TO    99C 

PRINT    925.IC0L 
"TZT^TTTIKAT   7*  PUNCHTNG  1VE5PEC  TCR    !COl=*  HZ) 

PUNCH    940»(S(1) ,1=1,NNP2) 
940    FCRMAT     (16F5.4) 
990    CONTINUE 


RETURN 

"END   " 
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LEVEL   21  ttK  CAT  A  ©ATE  *  77144         21/35/43 

BLOCK    DATA 

COKKON/  INPARft/COKPN (3 1  •  ICOL  ■  1C*  tLSEHS  ,THI AM  .HUE M  tVRft! 
C  MIND    COMPONENT    ALPHANUMERIC    DATA    (STORES   LEFT    JUSTIFIED! 

DATA    CONPN/lHUtlHRalHM/ 
ERD 
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LEVEL      21  U9CAL  OATE    «    76196  S%/32/06 

SUBROUTINE    UfCAL CU, V ,BFAC, VFAC  ) 

REAL    If,  V.Uf  AC, VFAC, A  68>,AIJ,AVvTHETA,1R,CR 

DATA   A/  99  .70$  63,5  .69133*  -6%  .69608 ,-69.5  257% ,85 .190>7,?5 .5 OS  50, 

-  -56.69714,17.33202/ 
AADC3M=3. 16159/180.0 
AO=ABS(U)     &•* 

AV  =  ABS4V)  -£•  1 

lF((A'J.LE.1.0l.3ft.€AV.LE.1.0M    GO   TO    10 

THETA*ATAN2(AV.AUT 

IFC I  THETA.LE*  I2.0«AADC0N  11.08  •  (TbEl  A  .GE  .887  .9*R  ADCONm    60    TO   10 

lR=100.0«COSCrHETAl 

CR«Atl )*A{2)»THETA*Af3)»THETA*»2*A{6)*THETA**3*Al5)*THETA»»4 

-  ♦A16)*THETA*«5*A(7*«THETA*«6«A18)»THETA»*7 
UFAOIR/CR 

lHEfA^9  0.0»R4DC3li-THETA 

IR*100.0*CGS|THETA1 

CR*AllWA«2)*THETA«»At3lMHETA»«2«A(4l»THETA»»3*AI5leTHETA»«4 

-  ♦  A(6)*4iiETA«*5«*C71»THETA»*6«A  18  l»THETA»»7 
VFAOJR/CR^ 

GO  TO  20 
10  UFAC=1.0 

VFAC  =1.0 
20  RETURN 

END 
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LEVEL       21  WlfcGL  CAT!    =    77103  10/57/C4 

51BRCUTINE    WANGL     (  Ut  V  ,  W  ,*  F  ,Afc  GL  tt  Av  tV  Av  ,W  Av  tATT  ACK  J 
C  F INC    AVERAGE    ANGLES    BE  ThE  EN    H*D    DATA    COHFCNENTS    *P    POINTS    LOAG 

C  IMENSICN    1(1) ,VC1) ,K(1) 
C  INITIALIZE 

U!UM=0. 

V5UH=0. 

K«UK=0. 

DC    5C    1=1,  NP 

USUM  =  USLM>»U(I  ) 

V!UM=VSLH«V  (I  ) 
50    fc«UP  =  W5LP«hm 

UAV=l'SU*/NP 

VAV=VSUM/NP 

HAV=hSUW/NP 

T*KC=YAV/l«V 

A*GL=ATAN(TANG) 

A*GL=ANGL«57.3 

TANGW=WAV/UAV 

A1TA(K*M  AN  (TAhGM  ) 

A1TACK=ATTACK*5T.3 

RETURN 

END 
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LEVEL       21  MER&2  DATE         76021  19/26/53 


SUBROUTINE    A VERG2 (A , N.NA f E,R ) 
C  SU3R3JMNE     4/E%SSU,N.NAVE,RI 

DIMENSION    AtlJ.RHJ 

DD    10    1=1, NAVE, 2 

IF( I  .NE  .1)       &0    TO    8 

ADD=A(1)  

R(l  )=U1  ) 

&0    TO    10 
8       ADD=ADD*A( Il+Ad-1 ) 

1 1  =  I  /?♦  1 

R(I I  )=ADD/I 
10  CONTINUE  

II=NAVE/2 

NP=NAVE*1 

DO    20    1=NP,N 

A0D=A0D-A(1-1A^E )*A(I) 

R(l-NftVE/2)=ADD/NAVE 
20  CONTINUE  

NP=N-NAVE/2»1 

1 1 =S A/E 

DO    30    I =ND,N,2 

11=11-2 

ADD=ADt-A<l-2)-A( 1-3) 

Rl  1  )  =\ D D /  I  1  

30  C0ST1SJE 

R(N )=A(N) 

RU  )=(A(1)+A(2)+A(3)  1/3.0 

R(2)=(Ml)  +  A(2)*M3)«MU)/<..0 

Rm  =  (A(N)*A(Y-l)fACN-2))/3.) 

R(N-l)=(A(N)*A(N-l)*AtN-2)+A(N-3))  M.O 

C  DO    40    1  =  1, N 

C  A( I )=R( I) 

t*0  CIHTHJE 

RETURN 

END 
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PROGRAM  WNDPRM 

INTRODUCTION 

Given  a  horizontal  or  vertical  wind  spectrum  which  averaged 
from  several  channels,  there  is  a  need  to  calculate  those  para- 
meter (such  as  surface  drag  coefficient,  etc.)  resulting  from 
fitting  the  data  to  the  equation  for  a  wind  spectrum  model. 

Program  WNDPRM  does  this  by  inputting  one  or  more  spectra 
on  punched  cards  from  program  WNDSPC  and  outputting  the  calculated 
wind  parameter  values  plus  a  Calcomp  plot  of  the  fit  model  spectrum 
superimposed  on  the  input  real  spectrum. 

This  program  is  used  in  two  separate  versions  for  horizontal 
and  vertical  wind  data,  each  of  which  uses  its  own  model  equation. 
For  the  horizontal  wind,  the  Harris  model  is  used,  while  the 
Panofsky  model  is  used  for  the  vertical  wind  data.   The  equations 
for  these  curves  with  their  associated  parameters  is  shown  in  the 
accompanying  pages  of  equations. 

See  Figures  69  through  71,  Table  18  and  Listings  40  and  41. 
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Figure  69.   WNDPRM  Flow  Chart 
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Table  18.   WNDPRM  Variable  Name  List 


Name 

A 

ASIGSQ 

AVEL 

B 

EL 

EVENT 

FMAX 

I 

IBUF 

I COUNT 

ID 

J 

KAPPA 

KK 

M 

MAXWN 

N 

NPLT 

RSH 

RSMAX 

RSP 

SPA   • 

SPB 

XOF 

YOF 

WN 

ZEE 

ZO 


Com 


Type 


R 

R 
R 
R 
R 
R 
R 
I 
I 
I 
I 
I 
R 
I 
I 
R 
I 
I 
R 

R 
R 

R 

R 
R 

R 
R 
R 
R 


Dimension 


1026 

1 

1 
1026 

1 

1 

1 

1 
2000 

1 

1 

1 

1 

1 

1 
•  1 

1 

1 
1026 

1 

1 
1026 
1026 

1 

1 
1026 

1 

1 


Usage 


Average  horizontal  wind  spectrum 

Wind  variance 

Average  wind  velocity 

Average  vertical  wind  spectrum 

Length  constant 

Event  number 

Max.  frequency 

General  index 

Plotter  buffer  storage 

Number  of  data  points 

Event  number 

General  Index 

Surface  drag  coefficient 

General  index 

Data  counter 

Max ,    wavenumber 

Data  Counter 

Number  of  spectra  to  process 

Harris  model  spectral  curve 

Max.  amplitude  of  input  spectrum 

Panofsky  model  spectral  curve 

Horizontal  spectrum  data 

Vertical  spectrum  data 

X  coordinate  offset  for  plotter 

Y  coordinate  offset  for  plotter 

Height  of  bridge  deck 
Surface  roughness  length 
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****«***«•  PROGRAM    NNDPRM    fHORIZ    VERSION)  #♦*•##•••*• 

THIS    PROGRAM    INPUTS    A    SET   OF    AVERAGE    HORIZONTAL    MIND   GUST 
SPECTRAL    VALUES    ON    CARDS    FRO*    PRCGRAM    NND5PC    INTO    ARRAY    A. 

THE    OUTPUT    IS    CALCULATED   MUD   PARAMETERS    AND    A    PLOT   OF    THIS 
SPECTRUM    VERSUS    THE    HARRIS    MCDEL    SPECTRUM    OF    SAME    PARAMETERS. 

DIMENSION    A (1026) ,WN (1026  I ,RSH 1 10  26 ) , SPAi 1026) • It IF  12000 ) 

INTEGER    USPEED 

REAL    MAXWN, KAPPA 

CALL    PLOTS    (IBUF, 2000,9) 

CALL    NEWPEN    (1) 

USE    FACT0R=.40    FOR    CALCOMP,     .67    FOR    TEKTRONIX 
CALL    FACT0RI.67) 
CULL    FACTOR    (.40) 
CALL    PLOT    t-30. 0,-56.0, -3) 
CALL    PLOT    (2.0,6.0,-3) 

ADD    XOFFSET    AND    YOFFSET    TO    DRIGIK    SO    AXIS    LABELS    NOT    CUTOFF 
ICF=1.0 


XOF=0. 

YCF=2.0 

VOF=0. 

c 

c 

READ    IN 

c 

THE    RUN    PARAMETERS 

READ(1,4)    NPLT 

4  FORMAT     (12) 

DO    310    KK=1,NPLT 
READ(1,5)     ID 

5  FORMAT     (121 

READ (1,100)    RSMAX,FMAX,AVEL,AS)GSQ,ZEE 
100    FORMAT     (5F10.5) 
C 

C  CALCULATE    SURFACE    ROUGHNESS   LENGTH(ZO),    SURFACE    DRAG   CQEF(KAPPA), 

C  AND    LENGTH    CONSTANT (L) 

C 

MAXWN    =    FMAX/AVEL 

Z0  =  EXP(ALOG(ZEE)-SQRT(.lt«1.812*(AVEL*«2.)/(RSMAX«ASIGSQm 
KAPPA    =    .]6/((AL0G(10./ZCI)««2.) 

EL    =    (SQRT(3.)*AL0G(1C./2C)1/(KAXWI*AL0G(ZEE/Z0n 
UR1TEO.10)     ID 
10    FORMAT(1H1,4X,>HORIZORTAL    WIND    COMPONENT    FOR    EVENT*8, 12) 

WR1TE(3,20) 
20    FORMAT     ( 1H0 ,4X ,20HR E DL CEC    SPECTRA    PAX  .,4X  ,14HFREQLENCY    MAX., 
14X.13HAVE.    VELOCITY, 4X.13HAVE.    V ARI ANCE ,4X , 11HMEAI    HEIGHT) 
WRITE  (3,30)    RSM AX, FM Al, A V EL  ,AS1GSQ, ZEE 
30    FORMAT     ( 1H0 ,6X ,F1 0.5 ,12X ,F10.5,6X ,F 10 .5 ,8X ,F10  .5  ,4X  ,F10  .5) 

WR1TE13.40)    ZO, KAPPA, EL 
40    FORMAT     ( 1H0 ,4X , •ROUGHNESS    LENGTH    =    •  ,F 10 .6  ,4X , 'SURFACE    DRAG    », 
lKOETFIClENT    «    •,F10.8,4X»»LENCTH    CONSTANT    =    ••F1C.4) 
C 

C  READ    FREQUENCY    MULTIPLIER    AND   P.S. 

C 

M=l 
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200    N*M*15 

210    READ(1,220,EWD=240)     (*(!),)=*  ,M 

220    FCRMAT     (16F5.4) 

IF    (ft. GE. 1024)  GO    TO    240 

M=N«1 

GO    TO    200 
C 

240  ICOUNT    *    1024 
UJtlTE  (3,241)    ICOUNT 

241  FORMAT     ( 1H0 ,4X ,  "I  COUNT    *    ",14) 
NRITEC3.242) 

242  FORMAT     ( 1H0 ,4X , »W A VE    NUMB ER ■ ,3X , »AV ER AGE    SPECTRA, SEAL    DATA", 
13X, 'HARRIS    FIT    SPECTRUM 

C 

C  CALCULATE    VALUES    FOR    FARR1S    MODEL    FOR  1Z0NTAL    SPECTRAL    CURVE 

C 

DC    250    1=1, ICOUNT 
250    WN( I)=( 1*1 1.78 5 71/1024.) I/AVEL 

DO    260    1=1,  ICOUNT 
260    RSHm  =  (4.*.4*«2.*AVEl««2.)/(A5IGSC»ALOG(10./ZO)«ALOG(ZEE/Z0)) 
l*(f EL»WN(1) )/((2«(WN( l)«EL*(ALCG(2EE/ZO)/ALOG(10.iZ0)))**2.) 
2**(5./6.)H       *YOF 

DC    280     1=1, ICOUNT 

SPACI)*A{I)       *YOF 

IF    (SPA(l)  .GT.9.0)  5PA(I)=9.C 

280    WR1TEC3.300)    UN ( 1 ) , A (  )  )  ,R5H { 1 ) 
300    FCRMAT    C4X,F10.5,8X,F10.5,12X,F10.5) 

WN     (1CTJUNT*1>=0.0001 

MNUC0UNT*2)*0.333 

SPAUC0UNT-»1)=2.0 

SPA{1COUNT-»H=0.0 

SPA(1COUNT*2)=0.05 

RSH(1C0UNT*1)=2.0 

R5H(1C0UNT*1)=0.0 

RSH(lC0UNT-t2)*0.05 
C 

C      PLOT  THE  CURVES 
C 

CALL  LGAXS  (X0F.Y0F.1H  ,-1 , 12 .0 ,0 .C ,0 .000 1 ,0 .333  ) 
C      CALL  LGAXS  (0.0, 0.0, IF  ,-]  ,12  .C  ,0  .C  ,0  .000  1 ,0  .333  ) 

CALL  AXIS  (XQF,Y0F,1H  ,1  ,8  .0 ,9C .0  ,C  .0  ,0  .05  ) 

CALL    LGL I N(WN, SPA, ICOUNT, 1  ,0,0,-1) 

CALL    LGLINt UN , RSH.1C 00 NT,1, 0,0,-1) 

CALL    StMBDL«XOF,YOF-1.0,C.21,6FEVEkT=,C.,6) 

US=USPEED 

EVENT=1D  . 

CALL    NUMBER    1999 .  ,999  .  , .2 1 , EVEfcT ,0 .0 , -1 ) 

CALL    PLOT     10.0,10.0,-3) 
310    CONTINUE 

CALL    PLOT     t0=0t0=0j999! 

WRITE     (3,450) 
450    FORMAT     (•    END    OF    FILE    WRITTEN    ON    PLOTTAPEM 

STOP 

END 
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••«•«••««•  PROGRAM    WADPRN    (VERTICAL    VERSION)  ••••••••••• 

ThI5    PROGRAM    INPUTS    A    SET    OF   AVERACE    VERTICAL    WIRC    GUST 
SPECTRAL    VALUES    ON    CARDS    FRO*    PRCGMW    WNDSPC    INTO    ARRAY    A. 

THE    OUTPUT    IS    CALCULATED    HUD    PARAMETERS    AND    A    PLOT   OF    THIS 
SPECTRUM    VERSUS    THE    PAWOFSKY   MCDEL    SPECTRIN    OF    SAFE    PARAMETERS. 

DIMENSION    6(10261  ,WN C 1026  )  ,RSP 1 1026  I . SPBC 10261 ,  IBLF 12000 1 

INTEGER    USPEED 

REAL    MAXWN, KAPPA 

CALL    PLOTS    (IBUF,2000,S1 

CALL    NEWPEN    (1) 
C  USE    FACT0R=.40    FOR    CALCCMP,    .61    FOR    TEKTRONIX 

CALL    FACT0RC.67) 

CALL  FACTOR  ( .40) 
C      CALL  PLOT  (-30.0,-56.0,-31 

CALL    PLOT     (2.0,6.0,-3) 
C  ADD    XOFFSET    AND    VOFFSET    TO   ORIGIft    SO    AXIS    LABEL!   NOT    CUTOFF 

X0F=1.0 

XOF=0. 

T0F=2.0 

XCF=0. 

VCF=0. 

c 

C  READ    IN    THE    RUM    PARAMETERS 

C 

READ(1,4)    NPLT 

4  FORMAT     (12) 

00    310    KK=1,NPLT 
READ(1,5)    ID 
C  READ(1,5)    USPEED 

5  FORMAT    (12) 

READ (1,100)    RSWMAX.FMAX.AVEL.WVAR ,2EE 
100    FCRMAT     (5F10.5) 
C 

C  CALCULATE    SURFACE    ROUChNESS   LEAGTMZO),    SURFACE    DRAG   COEF(KAPPA), 

C  AND   LENGTH   CONSTANT(L) 

C 

MAXWN  =  FMAX/AVEL 

ZC=EXP(ALOG(ZEE)-SQRT(t  .16 • (A VEL *«2 . ) ».375 ) /(RSWN AX«WVAR ) ) ) 
KAPPA    *    .16/((AL0G(10./ZC))*«2.) 
PMAXHN-.25/ZEE 
WRITE (3,101    ID 
10    FORMAT     (1H1,4X,  "VERTICAL    WIND    COMPONENT    FOR    EVENT*", 12) 

NRITE(3,20) 
20    FORMAT    (  1H0  ,4X  ,20HREDLCEC    SPECTRA    FAX  .,4X  ,  14HFR  ECLENC  Y   MAX., 
14X13HAVE.    VELOCITY, 4X.13FAVE.    VAR  IANCE ,4X .11HME AN    HEIGHT) 
WRITE (3  ,30)    RSWMAX,FMAX,AVEL,WVAR  ,2EE 
30    FORMA-T     (  1H0  ,8X  ,F10  .5  ,  12X  ,  F10.  5,6X  ,F  10  .5  ,8  X  ,F10  .5, AX  ,F10  .5  ) 

WRITE (3  ,40 1    ZO.KAPPA.PMAXWM.MAXWh 
40    FORMAT     I1H0 ,4X, "ROUGHAESS    LEAGTH    =    ",F10 .6 ,4X  ,  •SUPFACE    DRAG    •, 
^COEFFICIENT    =    • , F10 .8 ,//4 X, "PANCF2K Y    PEAK    WAVE    NLMBER    *    ",F10.6, 
24X, 'AVERAGE    SPECTRA    PEAK    WAVE    NUMBER    «=    ",F10.6J 
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C       READ  FREQUENCY  MULTIPLIER  AMD  P.S. 
C 

H  =  l 
200  N=M«15 

210  READil,220,END=240!  (i(ll,I^eM 
220  FCRMAT  (16F5.4) 

IF  (N.GE.1024)    GO  TO  240 
K=N*1 
GO  TO  200 
C 

240  ICOUNT  =  1024 
KRITEC3.241)  ICOUNT 

241  FORMAT  UHO  ,4X  ,»1  COUNT  *  •  ,  14  J 
NRITEt3,242) 

242  FORMAT  ( 1H0 ,4X , «H AVE  RUKB ER », 3S , 8 A\ ERAGE  SPECTRA, REAL  DATA"* 
13X, 'PANOFSKY  FIT  SPECTRA  •  1 

C 

C      CALCULATE  VALUES  FOR  PANCFSKt  HDDEL  VERTICAL  SPECTRAL  CURVE 

C 

DC  250  1  =  1, ICOUNT 
250  WM  11  =(  I*  (1.785  71/1024. 1  WAVE  L 

DC  260  1=1, ICOUNT 
260  RSP(11=(.H«(AVEL«»2.1  1  /  (WAR  •(  (ALE  G  (  ZEE/10  1««2  .1  J) 
l*(6.«WN(IJ*7EEl/(fl.«C4.«kN(I  MZEE1 1**2  .]   «VOF 

DC  280  1  =  1,  ICOUNT 

5PB ( I )=B ( 1  J   ♦YOF 

IF  (SPBlll  .GT.9.01    SPBII)-5.C 
280  WRITE(3,300)  WN ( I  I ,B { 1 ) ,RSP ( 1 ) 
300  FORMAT  (4X ,F10 .5 ,8X , F10  .5  ,16X ,F 1C  .5  1 

UN  (ICOUNT* 11=0.0001 

WN(1C0UNT*2)=0.333 

5PB(1C0UNT-»11=2.0 

SPB(1C0UNT«11=0.0 

SPB(ICOUNT+21=0„05 

RSP(IC0UNT«ll=2.0 

RSP(IC0UNT-»1)=0.0 

R5P(IC0UNT«2l*=0.05 
C 

C      PLOT  THE  CURVES 
C 

CALL  LGAXS  IX0F,Y0F,1F  ,-1  ,  12 .0 ,0 -C ,0  .000 1 , 0.3 33 1 

CALL  AXIS  (XOF.VOF.IH  ,  1  ,8  .0 ,9C .0  ,C .0  ,0 .05  1 

CALL  LGL IN (WN.SPB.1C0UKT  ,1,0,0,-11 

CALL  LGL1NIWN  ,R5P  ,1  COURT  ,1,0,0,-1 1 

CALL  SYMBOLCXOF,YOF-1.0,0.21,6»EVERT=,0.,61 

US=U5PEED 

EVENT=ID 

CALL  NUMBER  (999 .  ,999  .  ,  .2  1 ,  EV EIT ,0 .0 ,-1 1 

CALL  PLOT  (0.0,10.0,-3) 
310  CONTINUE 

CALL  PLOT  (0.0,0.0,9991 

WRITE  (3,4501 
450  FORMAT  (•  END  OF  FILE  WRITTEN  ON  PLOTTAPEM 

STOP 
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FEDERALLY   COORDINATED    PROGRAM  OF  HIGHWAY 
RESEARCH  AND   DEVELOPMENT    (TCP) 


I  he  Offices  of  Research  and  Development  of  the 
Federal  Highway  Administration  are  responsible 
for  a  broad  program  of  research  with  resources 
including  ils  own  staff,  contract  programs,  and  a 
federal- Aid  program  which  is  conducted  by  or 
through  the  State  highway  departments  and  which 
also  finances  the  National  Cooperative  Highway 
Research  Program  managed  by  the  Transportation 
Research  Hoard.  The  Federally  Coordinated  Pro- 
gram of  Highway  Research  and  Development 
I  FCP)  is  a  carefully  selected  group  of  projects 
aimed  at  urgent,  national  problems,  which  concen- 
trates these  resources  on  these  problems  to  obtain 
timely  solutions.  Virtually  all  of  the  available 
funds  and  staff  resources  are  a  part  of  the  FCP. 
together  with  as  much  of  the  Federal-aid  research 
funds  of  the  States  and  the  NCHRP  resources  as 
the  States  agree  to  devote  to  these  projects.'" 


FCP   Category   Descriptions 

1.  Improved    Highway   Design    and    Opera- 
tion for  Safety 

Safety  R&D  addresses  problems  connected  with 
the  responsibilities  of  the  Federal  Highway 
Administration  under  the  Highway  Safety  Act 
and  includes  investigation  of  appropriate  design 
standards,  roadside  hardware,  signing,  and 
physical  and  scientific  data  for  the  formulation 
of  improved  safety  regulations. 

2.  Reduction     of     Traffic     Congestion    and 
Improved  Operational  Efficiency 

Traffic  R&D  is  concerned  with  increasing  the 
operational  efficiency  of  existing  highways  by 
advancing  technology,  by  improving  designs  for 
existing  as  well  as  new  facilities,  and  by  keep- 
ing the  demand-capacity  relationship  in  better 
balance  through  traffic  management  techniques 
such  as  bus  and  carpool  preferential  treatment, 
motorist  information,  and  rerouting  of  traffic. 


*  Tin*  complete  "-volume  official  statement  of  the  FCP  is 
available  from  the  National  Technical  Information  Service 
(NTIS),  Springfield,  Virginia  22161  (Order  No.  PB  242057. 
price  $4.")  postpaid).  Single  copies  of  the  introductory 
volume  are  obtainable  without  charge  from  Program 
Analysis  (HRD-2),  Offices  of  Research  and  Development. 
Federal    Highway    Administration.    Washington,    D.C.    20500. 


3.  Environmental  Considerations  in  High- 
way Design,  Location,  Construction,  and 
Operation 

Environmental  R&D  is  directed  toward  identify- 
ing and  evaluating  highway  elements  which 
affect  the  quality*  of  the  human  environment. 
The  ultimate'  goals  are  reduction  of  adverse  high- 
way and  traffic  impacts,  and  protection  and 
enhancement  of  the  environment. 

4.  Improved  Materials  Utilization  and  Dura- 
bility 

Materials  R&D  is  concerned  with  expanding  the 
knowledge  of  materials  properties  and  technology 
to  fully  utilize  available  naturally  occurring 
materials,  to  develop  extender  or  substitute  ma- 
terials for  materials  in  short  supply,  and  to 
devise  procedures  for  converting  industrial  and 
other  wastes  into  useful  highway  products. 
These  activities  are  all  directed  toward  the  com- 
mon goals  of  lowering  the  cost  of  highway 
construction  and  extending  the  period  of  main- 
tenance-free operation. 

5.  Improved  Design  to  Reduce  Costs,  Extend 
Life  Expectancy,  and  Insure  Structural 
Safety 

Structural  R&D  is  concerned  with  furthering  the 
latest  technological  advances  in  structural  de- 
signs, fabrication  processes,  and  construction 
techniques,  to  provide  safe,  efficient  highways 
at  reasonable  cost. 

6.  Prototype  Development  and  Implementa- 
tion of  Research 

This  category  is  concerned  with  developing  and 
transferring  research  and  technology  into  prac- 
tice, or.  as  it  has  been  commonly  identified, 
"technology  transfer." 

7.  Improved  Technology  for  Highway  Main- 
tenance 

Maintenance  R&D  objectives  include  the  develop- 
ment and  application  of  new  technology  to  im- 
prove management,  to  augment  the  utilization 
of  resources,  and  to  increase  operational  efficiency 
and  safety  in  the  maintenance  of  highway 
facilities. 
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